(***************************************************************************)
(* 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 pythagoras_difference_lemmas.
Require Export ratios_elimination_lemmas.

Theorem elim_py_on_parallel_d_middle :
 forall (A B W U V Y : Point) (r : F),
 on_parallel_d Y W U V r -> 
 Py A Y B = Py A W B + r* (Py A V B - Py A U B  + 2* Py W U V  )-r*(1-r)*(Py U V U).
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
cases_equality W Y.

(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A D')) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
subst.
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
unfold on_parallel_d in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: @eq F (Py A B Y) (Fplus (Py A B Y) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
symmetry in H3.
(* Goal: @eq F (Py A B Y) (Fplus (Py A B Y) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
assert (r= 0).
(* Goal: @eq F r F0 *)
(* Goal: @eq F (Py A B Y) (Fplus (Py A B Y) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
IsoleVar r H3.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
rewrite H3.
(* Goal: @eq F (Fmult (Fdiv (DSeg C D) (DSeg A U)) (DSeg A U)) (DSeg C D) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
field;auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: @eq F (Fplus (Fmult (Fdiv (DSeg U Y) (DSeg U V)) (S V A B)) (Fmult (Fdiv (DSeg V Y) (DSeg V U)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
rewrite H.
(* Goal: @eq F (Py A B Y) (Fplus (Py A B Y) (Fmult F0 (Fminus (Py A B V) (Py A B U)))) *)
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
basic_simpl;auto.

(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
assert (parallel W Y U V).
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
unfold on_parallel_d in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
elim ( on_line_dex_spec_strong_f W Y U V H1 H0).
(* Goal: forall (x : Point) (_ : and (Col x W Y) (and (@eq F (DSeg W x) (DSeg U V)) (weak_3_parallelogram W x V U))), @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
intros S HS.
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
use HS.

assert (Py A Y B =
       W ** Y / W ** S * Py A S B + Y ** S / W ** S * Py A W B -
       W ** Y / W ** S * (Y ** S / W ** S) * Py W S W).
apply  (l3_5_py A B W S Y).
(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A D')) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
unfold not;intro;subst.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: Col A P Y *)
(* Goal: False *)
assert (U=V) by auto with Geom.
unfold on_parallel_d in *.
use H;auto.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.

(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
assert (W ** Y / W ** S = r).
unfold on_parallel_d in *.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: @eq F (Fdiv (Fplus (Fopp (DSeg W Y)) (DSeg W S)) (DSeg W S)) (Fminus F1 r) *)
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
rewrite H9.
(* Goal: @eq F (Fopp (S P Q Y)) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: not (@eq F (Fplus (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
rewrite H4.
(* Goal: @eq F F1 (Fdiv (Py4 C P D Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
field.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
rewrite H6 in H3.
assert ( Y ** S / W ** S  = 1 - r).
unfold on_parallel_d in *.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: Col A P Y *)
(* Goal: False *)
replace (Y**S) with (Y**W + W**S) by auto with Geom.
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_dir_seg.
(* Goal: @eq F (Fdiv (Py A P Q) (Py4 A P D' Q)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: not (@eq F (Py D' P Q) F0) *)
(* Goal: on_inter_line_perp Y P A D' P Q *)
rewrite H10.
(* Goal: @eq F (Fopp (S P Q Y)) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: not (@eq F (Fplus (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
rewrite H4.
(* Goal: @eq F (Fmult (Fdiv (DSeg C D) (DSeg A U)) (DSeg A U)) (DSeg C D) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
field;auto with Geom.
(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A D')) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
rewrite H7 in H3.
(* Goal: Col A P Y *)
(* Goal: False *)
assert (weak_3_parallelogram U V S W) by auto with Geom.

assert  (T:= l_27_c U V S W A B H8).

(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
revert T.
(* Goal: forall _ : @eq F (Fplus (Py U B A) (Py S B A)) (Fplus (Py V B A) (Py W B A)), @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
revert H3.
(* Goal: forall (_ : @eq F (Py A B Y) (Fplus (Fmult r (Py A B S)) (Fmult (Fminus F1 r) (Py A B W)))) (_ : @eq F (Fplus (Py U B A) (Py S B A)) (Fplus (Py V B A) (Py W B A))), @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
uniformize_pys.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
IsoleVar (Py A S B) T.
(* Goal: @eq F (Py A B Y) (Fplus (Py W B A) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
rewrite T in H3.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
rewrite H3.
replace (Py W S W) with (Py U V U).
2:unfold Py;basic_simpl;uniformize_dir_seg;rewrite H4;ring.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring.
Qed.

Theorem elim_py_on_parallel_d_right :
 forall (A B W U V Y : Point) (r : F),
 on_parallel_d Y W U V r -> 
 Py A B Y = Py A B W + r  * (Py A B V - Py A B U).
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.

(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
cases_equality W Y.
(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A D')) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
subst.
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
unfold on_parallel_d in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: @eq F (Py A B Y) (Fplus (Py A B Y) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
symmetry in H3.
(* Goal: @eq F (Py A B Y) (Fplus (Py A B Y) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
assert (r= 0).
(* Goal: @eq F r F0 *)
(* Goal: @eq F (Py A B Y) (Fplus (Py A B Y) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
IsoleVar r H3.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
rewrite H3.
(* Goal: @eq F (Fmult (Fdiv (DSeg C D) (DSeg A U)) (DSeg A U)) (DSeg C D) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
field;auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: @eq F (Fplus (Fmult (Fdiv (DSeg U Y) (DSeg U V)) (S V A B)) (Fmult (Fdiv (DSeg V Y) (DSeg V U)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
rewrite H.
(* Goal: @eq F (Py A B Y) (Fplus (Py A B Y) (Fmult F0 (Fminus (Py A B V) (Py A B U)))) *)
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
basic_simpl;auto.

(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
assert (parallel W Y U V).
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
unfold on_parallel_d in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
elim ( on_line_dex_spec_strong_f W Y U V H1 H0).
(* Goal: forall (x : Point) (_ : and (Col x W Y) (and (@eq F (DSeg W x) (DSeg U V)) (weak_3_parallelogram W x V U))), @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
intros S HS.
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
use HS.
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
assert (Py A B Y = W ** Y / W ** S * Py A B S + Y ** S / W ** S * Py A B W).
(* Goal: @eq F (Py A B Y) (Fplus (Fmult (Fdiv (DSeg W Y) (DSeg W S)) (Py A B S)) (Fmult (Fdiv (DSeg Y S) (DSeg W S)) (Py A B W))) *)
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
apply (l_28_b A B W S Y).
(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A D')) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
 intro;subst.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
 basic_simpl.
(* Goal: Col A P Y *)
(* Goal: False *)
 assert (U=V) by auto with Geom.
(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A D')) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
 subst. 
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
 unfold on_parallel_d in H.
(* Goal: False *)
 intuition.
(* Goal: Col A P Y *)
(* Goal: False *)
 auto with Geom.
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
unfold on_parallel_d in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
assert (W ** Y / W ** S = r).
(* Goal: @eq F (Fdiv (Fplus (Fopp (DSeg W Y)) (DSeg W S)) (DSeg W S)) (Fminus F1 r) *)
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
rewrite H9.
(* Goal: @eq F (Fopp (S P Q Y)) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: not (@eq F (Fplus (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
rewrite H4.
(* Goal: @eq F F1 (Fdiv (Py4 C P D Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
field.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
rewrite H in H3.
assert ( Y ** S / W ** S  = 1 - r).
(* Goal: Col A P Y *)
(* Goal: False *)
replace (Y**S) with (Y**W + W**S) by auto with Geom.
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_dir_seg.
(* Goal: @eq F (Fdiv (Fplus (Fopp (DSeg W Y)) (DSeg W S)) (DSeg W S)) (Fminus F1 r) *)
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
rewrite H9.
(* Goal: @eq F (Fopp (S P Q Y)) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: not (@eq F (Fplus (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
rewrite H4.
(* Goal: @eq F (Fmult (Fdiv (DSeg C D) (DSeg A U)) (DSeg A U)) (DSeg C D) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
field;auto with Geom.
(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A D')) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
rewrite H7 in H3.

(* Goal: Col A P Y *)
(* Goal: False *)
assert (weak_3_parallelogram U V S W) by auto with Geom.

(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
assert (T:= l_27_a U V S W B A H10).
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
revert T.
(* Goal: forall _ : @eq F (Fplus (Py U B A) (Py S B A)) (Fplus (Py V B A) (Py W B A)), @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
revert H3.
(* Goal: forall (_ : @eq F (Py A B Y) (Fplus (Fmult r (Py A B S)) (Fmult (Fminus F1 r) (Py A B W)))) (_ : @eq F (Fplus (Py U B A) (Py S B A)) (Fplus (Py V B A) (Py W B A))), @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
uniformize_pys.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: @eq F (Py A B Y) (Fplus (Py W B A) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
IsoleVar (Py S B A) T.
(* Goal: @eq F (Py A B Y) (Fplus (Py W B A) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
rewrite T in H3.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
rewrite H3.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring.
Qed.

Theorem elim_py_on_parallel_d_left_right :
 forall (B W U V Y : Point) (r : F),
 on_parallel_d Y W U V r -> 
 Py Y B Y = Py W B W + r * r * Py V B V - 2 * r * r * Py V B U + r * r * Py U B U +
2 * r * Py V B W - 2 * r * Py U B W.
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: @eq F (Py Y B Y) (Fminus (Fplus (Fplus (Fminus (Fplus (Py W B W) (Fmult (Fmult r r) (Py V B V))) (Fmult (Fmult (Fmult (Fplus F1 F1) r) r) (Py V B U))) (Fmult (Fmult r r) (Py U B U))) (Fmult (Fmult (Fplus F1 F1) r) (Py V B W))) (Fmult (Fmult (Fplus F1 F1) r) (Py U B W))) *)
rewrite (elim_py_on_parallel_d_right Y B W U V Y r H).
(* Goal: @eq F (Fplus (Fmult f (Py Y A Q)) (Fmult (Fminus F1 f) (Py Y A P))) (Fplus (Fmult f (Fplus (Fmult f (Py Q A Q)) (Fmult (Fminus F1 f) (Py Q A P)))) (Fmult (Fminus F1 f) (Fplus (Fmult f (Py P A Q)) (Fmult (Fminus F1 f) (Py P A P))))) *)
rewrite pyth_sym.
(* Goal: @eq F (Fplus (Py W B Y) (Fmult r (Fminus (Py Y B V) (Py Y B U)))) (Fminus (Fplus (Fplus (Fminus (Fplus (Py W B W) (Fmult (Fmult r r) (Py V B V))) (Fmult (Fmult (Fmult (Fplus F1 F1) r) r) (Py V B U))) (Fmult (Fmult r r) (Py U B U))) (Fmult (Fmult (Fplus F1 F1) r) (Py V B W))) (Fmult (Fmult (Fplus F1 F1) r) (Py U B W))) *)
replace ( Py Y B V) with (Py V B Y) by (apply pyth_sym;auto).
(* Goal: @eq F (Fplus (Py W B Y) (Fmult r (Fminus (Py V B Y) (Py Y B U)))) (Fminus (Fplus (Fplus (Fminus (Fplus (Py W B W) (Fmult (Fmult r r) (Py V B V))) (Fmult (Fmult (Fmult (Fplus F1 F1) r) r) (Py V B U))) (Fmult (Fmult r r) (Py U B U))) (Fmult (Fmult (Fplus F1 F1) r) (Py V B W))) (Fmult (Fmult (Fplus F1 F1) r) (Py U B W))) *)
replace ( Py Y B U) with (Py U B Y) by (apply pyth_sym;auto).
rewrite (elim_py_on_parallel_d_right W B W  U V Y r H).
rewrite (elim_py_on_parallel_d_right V B W  U V Y r H).
rewrite (elim_py_on_parallel_d_right U B W  U V Y r H).
(* Goal: Col A P Y *)
(* Goal: False *)
replace (Py W B U) with (Py U B W) by auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
replace (Py W B V) with (Py V B W) by auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
replace (Py U B V) with (Py V B U) by auto with Geom.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring.
Qed.

Theorem elim_py_on_line_d_right :
 forall (A B P Q Y : Point) (f : F),
 on_line_d Y P Q f ->
 Py A B Y = f * Py A B Q + (1 - f) * Py A B P.
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: @eq F (Py A Y B) (Fminus (Fplus (Fplus (Fplus (Fmult (Fopp (Py A P B)) r) (Py A P B)) (Fmult (Fmult r r) (Py Q P Q))) (Fmult r (Py A Q B))) (Fmult r (Py Q P Q))) *)
apply -> on_line_d_iff_on_parallel_d in H.
(* Goal: @eq F (Py A B Y) (Fplus (Fmult f (Py A B Q)) (Fmult (Fminus F1 f) (Py A B P))) *)
rewrite (elim_py_on_parallel_d_right A B P Q P Y (0-f) H).
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring.
Qed.

Theorem elim_py_on_line_d_left_right :
 forall (A P Q Y : Point) (f : F),
 on_line_d Y P Q f -> Py Y A Y = f* (f * Py Q A Q + (1 - f) * Py Q A P) +
(1 - f) * (f * Py P A Q + (1 - f) * Py P A P) .
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: @eq F (Py Y A Y) (Fplus (Fmult f (Fplus (Fmult f (Py Q A Q)) (Fmult (Fminus F1 f) (Py Q A P)))) (Fmult (Fminus F1 f) (Fplus (Fmult f (Py P A Q)) (Fmult (Fminus F1 f) (Py P A P))))) *)
rewrite (elim_py_on_line_d_right Y A P Q Y f H).
(* Goal: @eq F (Fplus (Fmult f (Py Y A Q)) (Fmult (Fminus F1 f) (Py Y A P))) (Fplus (Fmult f (Fplus (Fmult f (Py Q A Q)) (Fmult (Fminus F1 f) (Py Q A P)))) (Fmult (Fminus F1 f) (Fplus (Fmult f (Py P A Q)) (Fmult (Fminus F1 f) (Py P A P))))) *)
rewrite pyth_sym.
(* Goal: @eq F (Fplus (Fmult f (Py Q A Y)) (Fmult (Fminus F1 f) (Py Y A P))) (Fplus (Fmult f (Fplus (Fmult f (Py Q A Q)) (Fmult (Fminus F1 f) (Py Q A P)))) (Fmult (Fminus F1 f) (Fplus (Fmult f (Py P A Q)) (Fmult (Fminus F1 f) (Py P A P))))) *)
replace ( Py Y A P) with (Py P A Y) by (apply pyth_sym;auto).
(* Goal: @eq F (Fplus (Fmult f (Py Q A Y)) (Fmult (Fminus F1 f) (Py P A Y))) (Fplus (Fmult f (Fplus (Fmult f (Py Q A Q)) (Fmult (Fminus F1 f) (Py Q A P)))) (Fmult (Fminus F1 f) (Fplus (Fmult f (Py P A Q)) (Fmult (Fminus F1 f) (Py P A P))))) *)
rewrite (elim_py_on_line_d_right Q A P Q Y f H).
(* Goal: @eq F (Fplus (Fmult f (Fplus (Fmult f (Py Q A Q)) (Fmult (Fminus F1 f) (Py Q A P)))) (Fmult (Fminus F1 f) (Py P A Y))) (Fplus (Fmult f (Fplus (Fmult f (Py Q A Q)) (Fmult (Fminus F1 f) (Py Q A P)))) (Fmult (Fminus F1 f) (Fplus (Fmult f (Py P A Q)) (Fmult (Fminus F1 f) (Py P A P))))) *)
rewrite (elim_py_on_line_d_right P A P Q Y f H).
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
Qed.

Lemma elim_py_midpoint_left_right : forall A B C M : Point, 
on_line_d M B C (1 / 2) ->
       Py M A M = - (1)/(2+2) * (Py B C B - 2* Py A C A - 2 *Py A B A).
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
rewrite (elim_py_on_line_d_left_right A B C M (1/2)) by auto.
(* Goal: @eq F (Fplus (Fmult (Fdiv F1 (Fplus F1 F1)) (Fplus (Fmult (Fdiv F1 (Fplus F1 F1)) (Py C A C)) (Fmult (Fminus F1 (Fdiv F1 (Fplus F1 F1))) (Py C A B)))) (Fmult (Fminus F1 (Fdiv F1 (Fplus F1 F1))) (Fplus (Fmult (Fdiv F1 (Fplus F1 F1)) (Py B A C)) (Fmult (Fminus F1 (Fdiv F1 (Fplus F1 F1))) (Py B A B))))) (Fmult (Fdiv (Fopp F1) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Fminus (Fminus (Py B C B) (Fmult (Fplus F1 F1) (Py A C A))) (Fmult (Fplus F1 F1) (Py A B A)))) *)
field_simplify.
(* Goal: @eq F (S C U V) (Fplus (Fdiv (Fmult (Py P U V) (S C U V)) (Py U V U)) (Fdiv (Fmult (Py P V U) (S C U V)) (Py U V U))) *)
unfold Py.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_dir_seg.
(* Goal: @eq F (Fdiv (Fplus (Fplus (Fplus (Fplus (Fmult (Fopp (DSeg A C)) (Fopp (DSeg A C))) (Fmult (DSeg A C) (DSeg A C))) (Fminus (Fplus (Fmult (Fopp (DSeg A C)) (Fopp (DSeg A C))) (Fmult (DSeg A B) (DSeg A B))) (Fmult (Fopp (DSeg B C)) (Fopp (DSeg B C))))) (Fminus (Fplus (Fmult (Fopp (DSeg A B)) (Fopp (DSeg A B))) (Fmult (DSeg A C) (DSeg A C))) (Fmult (DSeg B C) (DSeg B C)))) (Fplus (Fmult (Fopp (DSeg A B)) (Fopp (DSeg A B))) (Fmult (DSeg A B) (DSeg A B)))) (Fmult (Fplus F1 F1) (Fplus F1 F1))) (Fdiv (Fplus (Fplus (Fopp (Fplus (Fmult (DSeg B C) (DSeg B C)) (Fmult (Fopp (DSeg B C)) (Fopp (DSeg B C))))) (Fmult (Fplus F1 F1) (Fplus (Fmult (DSeg A C) (DSeg A C)) (Fmult (Fopp (DSeg A C)) (Fopp (DSeg A C)))))) (Fmult (Fplus F1 F1) (Fplus (Fmult (DSeg A B) (DSeg A B)) (Fmult (Fopp (DSeg A B)) (Fopp (DSeg A B)))))) (Fmult (Fplus F1 F1) (Fplus F1 F1))) *)
(* Goal: not (@eq F (Fmult (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: not (@eq F (Fplus F1 F1) F0) *)
field_simplify_eq.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
(* Goal: not (@eq F (Fmult (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: not (@eq F (Py P Q P) F0) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
solve_conds.
(* Goal: not (@eq F (Fmult (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: not (@eq F (Py P Q P) F0) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
solve_conds.
(* Goal: not (@eq F (Fmult (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: not (@eq F (Py P Q P) F0) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
solve_conds.
Qed.

Theorem elim_py_on_line_right :
 forall A B P Q Y : Point,
 on_line Y P Q ->
 Py A B Y = P ** Y / P ** Q * Py A B Q + (1 - P ** Y / P ** Q) * Py A B P.
Proof with Geometry.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
assert (on_line_d Y P Q (P ** Y / P ** Q)).
apply on_line_to_on_line_d...
apply elim_py_on_line_d_right...
Qed.

Theorem elim_py_on_line_d_middle :
 forall A B P Q Y r,
 on_line_d Y P Q r ->
 Py A Y B = - Py A P B * r + Py A P B + r * r * Py Q P Q + r * Py A Q B- r * Py Q P Q .
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: @eq F (Py A Y B) (Fminus (Fplus (Fplus (Fplus (Fmult (Fopp (Py A P B)) r) (Py A P B)) (Fmult (Fmult r r) (Py Q P Q))) (Fmult r (Py A Q B))) (Fmult r (Py Q P Q))) *)
apply -> on_line_d_iff_on_parallel_d in H.
(* Goal: @eq F (Py A Y B) (Fminus (Fplus (Fplus (Fplus (Fmult (Fopp (Py A P B)) r) (Py A P B)) (Fmult (Fmult r r) (Py Q P Q))) (Fmult r (Py A Q B))) (Fmult r (Py Q P Q))) *)
rewrite (elim_py_on_parallel_d_middle A B P Q P Y (0-r) H).
(* Goal: Col A P Y *)
(* Goal: False *)
replace (Py P Q P) with (Py Q P Q) by auto with Geom.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring.
Qed.

(* shows that we need A<>B in elim_py_on_line_d_middle
Lemma essai : forall A P Q Y : Point, forall r:F,
 r<> 0 -> on_line_d Y P Q r -> False.
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
assert (Py A Y A = Py A Y A).
(* Goal: @eq F (Fdiv (Py A P Q) (Py4 C P D Q)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: not (@eq F (Py D' P Q) F0) *)
(* Goal: on_inter_line_perp Y P A D' P Q *)
reflexivity.
rewrite (elim_py_on_line_d_middle A A P Q Y r) in H1 at 1.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
2:auto.
(* Goal: Col A P Y *)
(* Goal: False *)
replace (Py A Y A) with (Py Y A Y) in H1 by auto with Geom.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
rewrite (elim_py_on_line_d_left_right A P Q Y r) in H1 by auto.
unfold Py in *.
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_dir_seg.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
field_simplify_eq in H1.
set (
- (2) * A ** P * A ** P * r + 2 * A ** P * A ** P +
2 * r * r * P ** Q * P ** Q) in H1.
set (2 * r * A ** Q * A ** Q) in H1.
assert (f + f0 - (f  + f0) = f - 2 * r * P ** Q * P ** Q + f0 - (f  + f0)).
(* Goal: @eq F (Fplus (Fmult (Fdiv (Py P U V) (Py U V U)) (S V A B)) (Fmult (Fdiv (DSeg V Y) (DSeg V U)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
rewrite H1.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring.
ring_simplify in H2.
assert (P**Q <> 0).
unfold on_line_d in H0.
use H0.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
assert (P ** Q * P ** Q <> 0).
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
apply nonzeromult; auto.
cut (r<>0).
(* Goal: forall _ : @eq F (DSeg A Y) (DSeg C D), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
intro.
assert (- (2) * r * P ** Q * P ** Q <> 0).
repeat (apply nonzeromult);
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
rewrite <- H2 in H6.
(* Goal: False *)
intuition.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
Qed.
*)

Theorem elim_py_on_line_middle :
 forall A B P Q Y : Point,
 on_line Y P Q ->
 Py A Y B = Py A P B + P ** Y / Q ** P * (Py A P B - Py A Q B + 2* Py Q P Q) -
P ** Y / Q ** P * (1 - P ** Y / Q ** P) * Py Q P Q.
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: @eq F (Py A Y B) (Fminus (Fplus (Py A P B) (Fmult (Fdiv (DSeg P Y) (DSeg Q P)) (Fplus (Fminus (Py A P B) (Py A Q B)) (Fmult (Fplus F1 F1) (Py Q P Q))))) (Fmult (Fmult (Fdiv (DSeg P Y) (DSeg Q P)) (Fminus F1 (Fdiv (DSeg P Y) (DSeg Q P)))) (Py Q P Q))) *)
apply -> on_line_iff_on_parallel in H.
(* Goal: @eq F (Py A Y B) (Fminus (Fplus (Py A P B) (Fmult (Fdiv (DSeg P Y) (DSeg Q P)) (Fplus (Fminus (Py A P B) (Py A Q B)) (Fmult (Fplus F1 F1) (Py Q P Q))))) (Fmult (Fmult (Fdiv (DSeg P Y) (DSeg Q P)) (Fminus F1 (Fdiv (DSeg P Y) (DSeg Q P)))) (Py Q P Q))) *)
apply on_parallel_to_on_parallel_d in H.
(* Goal: @eq F (Py A Y B) (Fminus (Fplus (Py A P B) (Fmult (Fdiv (DSeg P Y) (DSeg Q P)) (Fplus (Fminus (Py A P B) (Py A Q B)) (Fmult (Fplus F1 F1) (Py Q P Q))))) (Fmult (Fmult (Fdiv (DSeg P Y) (DSeg Q P)) (Fminus F1 (Fdiv (DSeg P Y) (DSeg Q P)))) (Py Q P Q))) *)
rewrite (elim_py_on_parallel_d_middle A B P Q P Y (P ** Y / Q ** P) H).
(* Goal: Col A P Y *)
(* Goal: False *)
replace (Py P Q P) with (Py Q P Q) by auto with Geom.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring.
Qed.

Theorem elim_py_inter_ll_right :
 forall A B P Q U V Y : Point,
 inter_ll Y P Q U V ->
 Py A B Y = 1 / S4 P U Q V * (S P U V * Py A B Q + S Q V U * Py A B P).
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: @eq F (Py A Y B) (Fminus (Fplus (Fmult (Fopp (Fdiv (S P V U) (S4 P U Q V))) (Py A Q B)) (Fmult (Fopp (Fdiv (S Q U V) (S4 P U Q V))) (Py A P B))) (Fmult (Fmult (Fopp (Fdiv (S P V U) (S4 P U Q V))) (Fopp (Fdiv (S Q U V) (S4 P U Q V)))) (Py P Q P))) *)
unfold inter_ll in H.
(* Goal: parallel Y P D' P *)
(* Goal: False *)
(* Goal: on_inter_line_perp Y P A D' P Q *)
decompose [and] H; clear H.
(* Goal: @eq F (Py A Y B) (Fminus (Fplus (Fmult (Fopp (Fdiv (S P V U) (S4 P U Q V))) (Py A Q B)) (Fmult (Fopp (Fdiv (S Q U V) (S4 P U Q V))) (Py A P B))) (Fmult (Fmult (Fopp (Fdiv (S P V U) (S4 P U Q V))) (Fopp (Fdiv (S Q U V) (S4 P U Q V)))) (Py P Q P))) *)
assert (P<>Q).
(* Goal: Col A P Y *)
(* Goal: False *)
eauto with Geom.
rewrite (l_28_b A B P Q Y).
(* Goal: Col A P Y *)
(* Goal: False *)
3:auto with Geom.
(* Goal: @eq F (Fminus (Fplus (Fmult (Fdiv (DSeg P Y) (DSeg P Q)) (Py A Q B)) (Fmult (Fdiv (DSeg Y Q) (DSeg P Q)) (Py A P B))) (Fmult (Fmult (Fdiv (DSeg P Y) (DSeg P Q)) (Fdiv (DSeg Y Q) (DSeg P Q))) (Py P Q P))) (Fminus (Fplus (Fmult (Fopp (Fdiv (S P V U) (S4 P U Q V))) (Py A Q B)) (Fmult (Fopp (Fdiv (S Q U V) (S4 P U Q V))) (Py A P B))) (Fmult (Fmult (Fopp (Fdiv (S P V U) (S4 P U Q V))) (Fopp (Fdiv (S Q U V) (S4 P U Q V)))) (Py P Q P))) *)
replace (Y ** Q / P ** Q) with (- (Q ** Y/ P**Q )).
(* Goal: Col A P Y *)
(* Goal: False *)
rewrite (co_side_bis U V P Q Y H3) by auto with Geom.
(* Goal: @eq F (Fminus (Fplus (Fmult (Fdiv (DSeg P Y) (DSeg P Q)) (Py A Q B)) (Fmult (Fopp (Fdiv (S Q U V) (S4 P U Q V))) (Py A P B))) (Fmult (Fmult (Fdiv (DSeg P Y) (DSeg P Q)) (Fopp (Fdiv (S Q U V) (S4 P U Q V)))) (Py P Q P))) (Fminus (Fplus (Fmult (Fopp (Fdiv (S P V U) (S4 P U Q V))) (Py A Q B)) (Fmult (Fopp (Fdiv (S Q U V) (S4 P U Q V))) (Py A P B))) (Fmult (Fmult (Fopp (Fdiv (S P V U) (S4 P U Q V))) (Fopp (Fdiv (S Q U V) (S4 P U Q V)))) (Py P Q P))) *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Q Y) (DSeg P Q))) (Fdiv (DSeg Y Q) (DSeg P Q)) *)
replace (P ** Y / P ** Q) with (- (P ** Y / Q ** P)).
(* Goal: @eq F (Fminus (Fplus (Fmult (Fopp (Fdiv (DSeg P Y) (DSeg Q P))) (Py A Q B)) (Fmult (Fopp (Fdiv (S Q U V) (S4 P U Q V))) (Py A P B))) (Fmult (Fmult (Fopp (Fdiv (DSeg P Y) (DSeg Q P))) (Fopp (Fdiv (S Q U V) (S4 P U Q V)))) (Py P Q P))) (Fminus (Fplus (Fmult (Fopp (Fdiv (S P V U) (S4 P U Q V))) (Py A Q B)) (Fmult (Fopp (Fdiv (S Q U V) (S4 P U Q V))) (Py A P B))) (Fmult (Fmult (Fopp (Fdiv (S P V U) (S4 P U Q V))) (Fopp (Fdiv (S Q U V) (S4 P U Q V)))) (Py P Q P))) *)
(* Goal: @eq F (Fopp (Fdiv (DSeg P Y) (DSeg Q P))) (Fdiv (DSeg P Y) (DSeg P Q)) *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Q Y) (DSeg P Q))) (Fdiv (DSeg Y Q) (DSeg P Q)) *)
rewrite (co_side_bis V U Q P Y).
(* Goal: @eq F (Fminus (Fplus (Fmult (Fopp (Fdiv (S P V U) (S4 Q V P U))) (Py A Q B)) (Fmult (Fopp (Fdiv (S Q U V) (S4 P U Q V))) (Py A P B))) (Fmult (Fmult (Fopp (Fdiv (S P V U) (S4 Q V P U))) (Fopp (Fdiv (S Q U V) (S4 P U Q V)))) (Py P Q P))) (Fminus (Fplus (Fmult (Fopp (Fdiv (S P V U) (S4 P U Q V))) (Py A Q B)) (Fmult (Fopp (Fdiv (S Q U V) (S4 P U Q V))) (Py A P B))) (Fmult (Fmult (Fopp (Fdiv (S P V U) (S4 P U Q V))) (Fopp (Fdiv (S Q U V) (S4 P U Q V)))) (Py P Q P))) *)
(* Goal: not (parallel Q P V U) *)
(* Goal: Col V U Y *)
(* Goal: Col Q P Y *)
(* Goal: @eq F (Fopp (Fdiv (DSeg P Y) (DSeg Q P))) (Fdiv (DSeg P Y) (DSeg P Q)) *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Q Y) (DSeg P Q))) (Fdiv (DSeg Y Q) (DSeg P Q)) *)
replace (S4 Q V P U) with (S4 P U Q V) by (auto with Geom).
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_signed_areas.
(* Goal: @eq F F1 (Fdiv (Py4 C P D Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
field.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: not (@eq F (Py D' P Q) F0) *)
(* Goal: on_inter_line_perp Y P A D' P Q *)
unfold not;intro.
assert (parallel P Q U V).
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: False *)
intuition.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: @eq F (Fopp (Fdiv (DSeg P Y) (DSeg Q P))) (Fdiv (DSeg P Y) (DSeg P Q)) *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Q Y) (DSeg P Q))) (Fdiv (DSeg Y Q) (DSeg P Q)) *)
rewrite dirseg_4 at 1.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: @eq F (Fopp (Fdiv (DSeg Q Y) (DSeg P Q))) (Fdiv (DSeg Y Q) (DSeg P Q)) *)
rewrite dirseg_3 at 1.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
Qed.

Theorem elim_py_inter_ll_right_invariant :
 forall A B P Q U V Y : Point,
 inter_ll Y P Q U V -> S4 P U Q V <> 0.
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: not (@eq F (S4 P U Q V) F0) *)
unfold inter_ll, parallel in H.
(* Goal: False *)
intuition.
Qed.

Theorem elim_py_inter_ll_left_right :
 forall B P Q U V Y : Point,
 inter_ll Y P Q U V ->
 Py Y B Y = 1 / S4 P U Q V *
(S P U V * (1 / S4 P U Q V * (S P U V * Py Q B Q + S Q V U * Py Q B P)) +
 S Q V U * (1 / S4 P U Q V * (S P U V * Py P B Q + S Q V U * Py P B P))).
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: @eq F (Py Y B Y) (Fmult (Fdiv F1 (S4 P U Q V)) (Fplus (Fmult (S P U V) (Fmult (Fdiv F1 (S4 P U Q V)) (Fplus (Fmult (S P U V) (Py Q B Q)) (Fmult (S Q V U) (Py Q B P))))) (Fmult (S Q V U) (Fmult (Fdiv F1 (S4 P U Q V)) (Fplus (Fmult (S P U V) (Py P B Q)) (Fmult (S Q V U) (Py P B P))))))) *)
rewrite (elim_py_inter_ll_right Y B P Q U V Y H).
(* Goal: Col A P Y *)
(* Goal: False *)
replace (Py Y B P) with (Py P B Y) by auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
replace (Py Y B Q) with (Py Q B Y) by auto with Geom.
(* Goal: @eq F (Fmult (Fdiv F1 (S4 P U Q V)) (Fplus (Fmult (S P U V) (Py Q B Y)) (Fmult (S Q V U) (Py P B Y)))) (Fmult (Fdiv F1 (S4 P U Q V)) (Fplus (Fmult (S P U V) (Fmult (Fdiv F1 (S4 P U Q V)) (Fplus (Fmult (S P U V) (Py Q B Q)) (Fmult (S Q V U) (Py Q B P))))) (Fmult (S Q V U) (Fmult (Fdiv F1 (S4 P U Q V)) (Fplus (Fmult (S P U V) (Py P B Q)) (Fmult (S Q V U) (Py P B P))))))) *)
rewrite (elim_py_inter_ll_right Q B P Q U V Y H).
(* Goal: @eq F (Fmult (Fdiv F1 (S4 P U Q V)) (Fplus (Fmult (S P U V) (Fmult (Fdiv F1 (S4 P U Q V)) (Fplus (Fmult (S P U V) (Py Q B Q)) (Fmult (S Q V U) (Py Q B P))))) (Fmult (S Q V U) (Py P B Y)))) (Fmult (Fdiv F1 (S4 P U Q V)) (Fplus (Fmult (S P U V) (Fmult (Fdiv F1 (S4 P U Q V)) (Fplus (Fmult (S P U V) (Py Q B Q)) (Fmult (S Q V U) (Py Q B P))))) (Fmult (S Q V U) (Fmult (Fdiv F1 (S4 P U Q V)) (Fplus (Fmult (S P U V) (Py P B Q)) (Fmult (S Q V U) (Py P B P))))))) *)
rewrite (elim_py_inter_ll_right P B P Q U V Y H).
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
Qed.

Theorem elim_py_inter_ll_left_right_invariant :
 forall B P Q U V Y : Point,
 inter_ll Y P Q U V -> S4 P U Q V <> 0.
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: not (@eq F (S4 P U Q V) F0) *)
unfold inter_ll, parallel in H.
(* Goal: False *)
intuition.
Qed.

Theorem elim_py_inter_ll_middle :
 forall A B P Q U V Y : Point,
 inter_ll Y P Q U V ->
 Py A Y B = - (S P V U / S4 P U Q V) * Py A Q B + - (S Q U V / S4 P U Q V) * Py A P B -
- (S P V U / S4 P U Q V) * - (S Q U V / S4 P U Q V) * Py P Q P.
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: @eq F (Py A Y B) (Fminus (Fplus (Fmult (Fopp (Fdiv (S P V U) (S4 P U Q V))) (Py A Q B)) (Fmult (Fopp (Fdiv (S Q U V) (S4 P U Q V))) (Py A P B))) (Fmult (Fmult (Fopp (Fdiv (S P V U) (S4 P U Q V))) (Fopp (Fdiv (S Q U V) (S4 P U Q V)))) (Py P Q P))) *)
unfold inter_ll in H.
(* Goal: parallel Y P D' P *)
(* Goal: False *)
(* Goal: on_inter_line_perp Y P A D' P Q *)
decompose [and] H; clear H.
(* Goal: @eq F (Py A Y B) (Fminus (Fplus (Fmult (Fopp (Fdiv (S P V U) (S4 P U Q V))) (Py A Q B)) (Fmult (Fopp (Fdiv (S Q U V) (S4 P U Q V))) (Py A P B))) (Fmult (Fmult (Fopp (Fdiv (S P V U) (S4 P U Q V))) (Fopp (Fdiv (S Q U V) (S4 P U Q V)))) (Py P Q P))) *)
assert (P<>Q).
(* Goal: Col A P Y *)
(* Goal: False *)
eauto with Geom.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
rewrite (l3_5_py A B P Q Y) by auto.
(* Goal: @eq F (Fminus (Fplus (Fmult (Fdiv (DSeg P Y) (DSeg P Q)) (Py A Q B)) (Fmult (Fdiv (DSeg Y Q) (DSeg P Q)) (Py A P B))) (Fmult (Fmult (Fdiv (DSeg P Y) (DSeg P Q)) (Fdiv (DSeg Y Q) (DSeg P Q))) (Py P Q P))) (Fminus (Fplus (Fmult (Fopp (Fdiv (S P V U) (S4 P U Q V))) (Py A Q B)) (Fmult (Fopp (Fdiv (S Q U V) (S4 P U Q V))) (Py A P B))) (Fmult (Fmult (Fopp (Fdiv (S P V U) (S4 P U Q V))) (Fopp (Fdiv (S Q U V) (S4 P U Q V)))) (Py P Q P))) *)
replace (Y ** Q / P ** Q) with (- (Q ** Y/ P**Q )).
(* Goal: Col A P Y *)
(* Goal: False *)
rewrite (co_side_bis U V P Q Y H3) by auto with Geom.
(* Goal: @eq F (Fminus (Fplus (Fmult (Fdiv (DSeg P Y) (DSeg P Q)) (Py A Q B)) (Fmult (Fopp (Fdiv (S Q U V) (S4 P U Q V))) (Py A P B))) (Fmult (Fmult (Fdiv (DSeg P Y) (DSeg P Q)) (Fopp (Fdiv (S Q U V) (S4 P U Q V)))) (Py P Q P))) (Fminus (Fplus (Fmult (Fopp (Fdiv (S P V U) (S4 P U Q V))) (Py A Q B)) (Fmult (Fopp (Fdiv (S Q U V) (S4 P U Q V))) (Py A P B))) (Fmult (Fmult (Fopp (Fdiv (S P V U) (S4 P U Q V))) (Fopp (Fdiv (S Q U V) (S4 P U Q V)))) (Py P Q P))) *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Q Y) (DSeg P Q))) (Fdiv (DSeg Y Q) (DSeg P Q)) *)
replace (P ** Y / P ** Q) with (- (P ** Y / Q ** P)).
(* Goal: @eq F (Fminus (Fplus (Fmult (Fopp (Fdiv (DSeg P Y) (DSeg Q P))) (Py A Q B)) (Fmult (Fopp (Fdiv (S Q U V) (S4 P U Q V))) (Py A P B))) (Fmult (Fmult (Fopp (Fdiv (DSeg P Y) (DSeg Q P))) (Fopp (Fdiv (S Q U V) (S4 P U Q V)))) (Py P Q P))) (Fminus (Fplus (Fmult (Fopp (Fdiv (S P V U) (S4 P U Q V))) (Py A Q B)) (Fmult (Fopp (Fdiv (S Q U V) (S4 P U Q V))) (Py A P B))) (Fmult (Fmult (Fopp (Fdiv (S P V U) (S4 P U Q V))) (Fopp (Fdiv (S Q U V) (S4 P U Q V)))) (Py P Q P))) *)
(* Goal: @eq F (Fopp (Fdiv (DSeg P Y) (DSeg Q P))) (Fdiv (DSeg P Y) (DSeg P Q)) *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Q Y) (DSeg P Q))) (Fdiv (DSeg Y Q) (DSeg P Q)) *)
rewrite (co_side_bis V U Q P Y).
(* Goal: Col A P Y *)
(* Goal: False *)
replace (S4 Q V P U) with (S4  P U Q V) by auto with Geom.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
(* Goal: forall _ : @eq F (DSeg A Y) (DSeg C D), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
intro.
(* Goal: Col A P Y *)
(* Goal: False *)
assert (parallel P Q U V); auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: @eq F (Fopp (Fdiv (DSeg P Y) (DSeg Q P))) (Fdiv (DSeg P Y) (DSeg P Q)) *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Q Y) (DSeg P Q))) (Fdiv (DSeg Y Q) (DSeg P Q)) *)
rewrite dirseg_4 at 1.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: @eq F (Fopp (Fdiv (DSeg Q Y) (DSeg P Q))) (Fdiv (DSeg Y Q) (DSeg P Q)) *)
rewrite dirseg_3 at 1.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
Qed.

Theorem elim_py_inter_ll_middle_invariant :
 forall A B P Q U V Y : Point,
 inter_ll Y P Q U V -> S4  P U Q V <> 0.
Proof.
(* Goal: forall (_ : Point) (_ : Point) (P Q U V Y : Point) (_ : inter_ll Y P Q U V), not (@eq F (S4 P U Q V) F0) *)
exact elim_py_inter_ll_right_invariant.
Qed.

Theorem elim_py_on_foot_right :
 forall A B P U V Y : Point,
 on_foot Y P U V ->
 Py A B Y = (Py P U V * Py A B V + Py P V U * Py A B U) / (Py U V U).
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: False *)
unfold on_foot in *.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: Col A P Y *)
(* Goal: False *)
rewrite (l_28_b A B U V) by auto with Geom.
(* Goal: @eq F (Fplus (Fmult (Fdiv (DSeg U Y) (DSeg U V)) (S V A B)) (Fmult (Fdiv (DSeg Y V) (DSeg U V)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
assert (U**Y/U**V = Py P U V / Py U V U).
(* Goal: @eq F (Fdiv (DSeg V Y) (DSeg V U)) (Fdiv (Py P V U) (Py V U V)) *)
(* Goal: @eq F (Fplus (Fmult (Fdiv (DSeg U Y) (DSeg U V)) (S V A B)) (Fmult (Fdiv (DSeg Y V) (DSeg U V)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
apply l_24_c_on_foot.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
unfold on_foot;auto.
(* Goal: @eq F (Fplus (Fmult (Fdiv (DSeg U Y) (DSeg U V)) (S V A B)) (Fmult (Fdiv (DSeg Y V) (DSeg U V)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
assert (V**Y/V**U = Py P V U / Py V U V).
(* Goal: @eq F (Fdiv (DSeg V Y) (DSeg V U)) (Fdiv (Py P V U) (Py V U V)) *)
(* Goal: @eq F (Fplus (Fmult (Fdiv (DSeg U Y) (DSeg U V)) (S V A B)) (Fmult (Fdiv (DSeg Y V) (DSeg U V)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
apply l_24_c_on_foot.
(* Goal: Col A P Y *)
(* Goal: False *)
unfold on_foot;auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
replace (Y ** V / U ** V) with (V**Y/V**U) by auto with Geom.
(* Goal: @eq F (Fplus (Fmult (Fdiv (DSeg U Y) (DSeg U V)) (S V A B)) (Fmult (Fdiv (DSeg V Y) (DSeg V U)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
rewrite H.
(* Goal: @eq F (Fplus (Fmult (Fdiv (Py P U V) (Py U V U)) (S V A B)) (Fmult (Fdiv (DSeg V Y) (DSeg V U)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
rewrite H1.
(* Goal: Col A P Y *)
(* Goal: False *)
replace (Py V U V) with (Py U V U) by auto with Geom.
(* Goal: @eq F (Fmult (Fdiv (DSeg C D) (DSeg A U)) (DSeg A U)) (DSeg C D) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
field;auto with Geom.
Qed.

Theorem elim_py_on_foot_left_right :
 forall B P U V Y : Point,
 on_foot Y P U V ->
 Py Y B Y = 
 (Py P U V * Py P U V * Py V B V + Py P U V * Py P V U * Py V B U +
 Py P U V * Py P V U * Py U B V + Py P V U * Py P V U * Py U B U) / (Py U V U *  Py U V U).
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: @eq F (Py Y B Y) (Fdiv (Fplus (Fplus (Fplus (Fmult (Fmult (Py P U V) (Py P U V)) (Py V B V)) (Fmult (Fmult (Py P U V) (Py P V U)) (Py V B U))) (Fmult (Fmult (Py P U V) (Py P V U)) (Py U B V))) (Fmult (Fmult (Py P V U) (Py P V U)) (Py U B U))) (Fmult (Py U V U) (Py U V U))) *)
rewrite (elim_py_on_foot_right Y B P U V Y H).
(* Goal: Col A P Y *)
(* Goal: False *)
replace (Py Y B V) with (Py V B Y) by auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
replace (Py Y B U) with (Py U B Y) by auto with Geom.
(* Goal: @eq F (Fdiv (Fplus (Fmult (Py P U V) (Py V B Y)) (Fmult (Py P V U) (Py U B Y))) (Py U V U)) (Fdiv (Fplus (Fplus (Fplus (Fmult (Fmult (Py P U V) (Py P U V)) (Py V B V)) (Fmult (Fmult (Py P U V) (Py P V U)) (Py V B U))) (Fmult (Fmult (Py P U V) (Py P V U)) (Py U B V))) (Fmult (Fmult (Py P V U) (Py P V U)) (Py U B U))) (Fmult (Py U V U) (Py U V U))) *)
rewrite (elim_py_on_foot_right V B P U V Y H).
(* Goal: @eq F (Fdiv (Fplus (Fmult (Py P U V) (Fdiv (Fplus (Fmult (Py P U V) (Py V B V)) (Fmult (Py P V U) (Py V B U))) (Py U V U))) (Fmult (Py P V U) (Py U B Y))) (Py U V U)) (Fdiv (Fplus (Fplus (Fplus (Fmult (Fmult (Py P U V) (Py P U V)) (Py V B V)) (Fmult (Fmult (Py P U V) (Py P V U)) (Py V B U))) (Fmult (Fmult (Py P U V) (Py P V U)) (Py U B V))) (Fmult (Fmult (Py P V U) (Py P V U)) (Py U B U))) (Fmult (Py U V U) (Py U V U))) *)
rewrite (elim_py_on_foot_right U B P U V Y H).
(* Goal: @eq F F1 (Fdiv (Py4 C P D Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
field.
(* Goal: @eq F (Fdiv (DSeg A P) (DSeg C D)) (Fdiv (S A U V) (Fplus (S C U D) (S C D V))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (S A U V) (S4 C U D V)) *)
unfold on_foot in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: @eq F (S C U V) (Fplus (Fdiv (Fmult (Py P U V) (S C U V)) (Py U V U)) (Fdiv (Fmult (Py P V U) (S C U V)) (Py U V U))) *)
unfold Py.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_dir_seg.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
replace (U ** V * U ** V + - U ** V * - U ** V) with (2* U ** V * U ** V) by ring.
(* Goal: Col A P Y *)
(* Goal: False *)
repeat (apply nonzeromult);auto with Geom.
Qed.

Theorem elim_py_on_foot_left_right_invariant :
forall B P U V Y : Point,
 on_foot Y P U V -> (Py U V U *  Py U V U) <> 0.
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: @eq F (Fdiv (DSeg A P) (DSeg C D)) (Fdiv (S A U V) (Fplus (S C U D) (S C D V))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (S A U V) (S4 C U D V)) *)
unfold on_foot in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: @eq F (S C U V) (Fplus (Fdiv (Fmult (Py P U V) (S C U V)) (Py U V U)) (Fdiv (Fmult (Py P V U) (S C U V)) (Py U V U))) *)
unfold Py.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_dir_seg.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
replace (U ** V * U ** V + - U ** V * - U ** V) with (2* U ** V * U ** V) by ring.
(* Goal: Col A P Y *)
(* Goal: False *)
repeat (apply nonzeromult);auto with Geom.
Qed.

Theorem elim_py_on_foot_right_invariant :
 forall A B P U V Y : Point,
 on_foot Y P U V -> Py U V U <> 0.
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: False *)
unfold on_foot in *.
(* Goal: @eq F (S C U V) (Fplus (Fdiv (Fmult (Py P U V) (S C U V)) (Py U V U)) (Fdiv (Fmult (Py P V U) (S C U V)) (Py U V U))) *)
unfold Py.
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_dir_seg.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
 replace (U ** V * U ** V + U ** V * U ** V) with
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(2 * U ** V * U ** V) by ring.
(* Goal: parallel Y P D' P *)
(* Goal: False *)
(* Goal: on_inter_line_perp Y P A D' P Q *)
decompose [and] H; clear H.
(* Goal: Col A P Y *)
(* Goal: False *)
repeat apply nonzeromult;auto with Geom.
Qed.

Theorem elim_py_on_foot_middle :
 forall A B P U V Y : Point,
 on_foot Y P U V ->
 Py A Y B = (Py P U V / Py U V U) * Py A V B + 
                  (Py P V U) / (Py  U V U) * Py A U B - 
                  (Py P U V * Py P V U) / Py U V U.
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
rewrite (l3_5_py A B U V) by
 (unfold on_foot in  *;intuition).
(* Goal: @eq F (Fplus (Fmult (Fdiv (DSeg U Y) (DSeg U V)) (S V A B)) (Fmult (Fdiv (DSeg Y V) (DSeg U V)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
assert (U**Y/U**V = Py P U V / Py U V U).
(* Goal: @eq F (Fdiv (DSeg V Y) (DSeg V U)) (Fdiv (Py P V U) (Py V U V)) *)
(* Goal: @eq F (Fplus (Fmult (Fdiv (DSeg U Y) (DSeg U V)) (S V A B)) (Fmult (Fdiv (DSeg Y V) (DSeg U V)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
apply l_24_c_on_foot.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
unfold on_foot;auto.
(* Goal: @eq F (Fplus (Fmult (Fdiv (DSeg U Y) (DSeg U V)) (S V A B)) (Fmult (Fdiv (DSeg Y V) (DSeg U V)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
assert (V**Y/V**U = Py P V U / Py V U V).
(* Goal: @eq F (Fdiv (DSeg V Y) (DSeg V U)) (Fdiv (Py P V U) (Py V U V)) *)
(* Goal: @eq F (Fplus (Fmult (Fdiv (DSeg U Y) (DSeg U V)) (S V A B)) (Fmult (Fdiv (DSeg Y V) (DSeg U V)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
apply l_24_c_on_foot.
(* Goal: False *)
unfold on_foot in *;intuition.
(* Goal: @eq F (Fopp (S A P Y)) F0 *)
(* Goal: False *)
(* Goal: @eq F (S Y P A) F0 *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: not (@eq Point Y P) *)
(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (S P Y Q) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
rewrite H0.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
unfold on_foot in *;use H.
(* Goal: Col A P Y *)
(* Goal: False *)
replace (Y ** V / U ** V) with (V**Y/V**U) by auto with Geom.
(* Goal: @eq F (Fplus (Fmult (Fdiv (Py P U V) (Py U V U)) (S V A B)) (Fmult (Fdiv (DSeg V Y) (DSeg V U)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
rewrite H1.
(* Goal: @eq F (Fminus (Fplus (Fmult (Fdiv (Py P U V) (Py U V U)) (Py A V B)) (Fmult (Fdiv (Py P V U) (Py V U V)) (Py A U B))) (Fmult (Fmult (Fdiv (Py P U V) (Py U V U)) (Fdiv (Py P V U) (Py V U V))) (Py U V U))) (Fminus (Fplus (Fmult (Fdiv (Py P U V) (Py U V U)) (Py A V B)) (Fmult (Fdiv (Py P V U) (Py U V U)) (Py A U B))) (Fdiv (Fmult (Py P U V) (Py P V U)) (Py U V U))) *)
replace (Py V U V) with (Py U V U).
(* Goal: @eq F F1 (Fdiv (Py4 C P D Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
field.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
Qed.

Theorem elim_py_on_foot_middle_invariant :
 forall A B P U V Y : Point,
 on_foot Y P U V -> Py U V U <> 0.
Proof.
(* Goal: forall (_ : Point) (_ : Point) (P U V Y : Point) (_ : on_foot Y P U V), not (@eq F (Py U V U) F0) *)
exact elim_py_on_foot_right_invariant.
Qed.

Theorem elim_py_on_perp_d_right :
forall A B P Q Y : Point, forall r: F,
on_perp_d Y P Q r ->
Py A B Y = Py A B P - (2+2) * r * S4 P A Q B.
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
unfold on_perp_d in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
assert (P<>Y).
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
intro;subst;basic_simpl.
IsoleVar (Py Y Q Y) H1.
replace (0/r) with 0 in H1 by (field;auto with Geom).
(* Goal: False *)
intuition.

elim (proj_ex A P Y H).
intros A1 HA1.
elim (proj_ex B P Y H).
intros B1 HB1.

assert (Py4 B P A Y / Py Y P Y = S4 P A Q B / S P Q Y).

replace (Py4 B P A Y) with (Py4 B1 P A1 Y).

assert (parallel A1 B1 P Y).
(* Goal: False *)
   unfold on_foot in *.
   use HA1.
   use HB1.
   cut (parallel Y P A1 B1).
(* Goal: Col A P Y *)
(* Goal: False *)
   auto with Geom.
(* Goal: parallel A Y P A *)
(* Goal: parallel A P C D *)
(* Goal: not (@eq Point A P) *)
   unfold parallel, S4.
(* Goal: @eq F (S Y P A) F0 *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: not (@eq Point Y P) *)
(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (S P Y Q) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
   unfold Col in *.
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
   uniformize_signed_areas.
   rewrite H6, H9.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
   ring.

(* Goal: Col A P Y *)
(* Goal: False *)
replace (Py Y P Y) with (Py P Y P) by auto with Geom.
rewrite <- (l3_10b A1 B1 P Y) by assumption.

replace (A1 ** B1 / P ** Y) with ((S4 P A1 Q B1) / (S P Q Y)).
replace (S4 P A1 Q B1) with (S4 P A Q B).
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
(* Goal: @eq F (Fdiv (S A U V) (S4 C U Y V)) (Fdiv (S A U V) (S C U V)) *)
unfold S4.
(* Goal: False *)
unfold on_foot in *.
use HA1.
use HB1.

assert (parallel P Q B B1).
(* Goal: Col A P Y *)
(* Goal: False *)
apply (perp_perp_para P Q Y P B B1);auto with Geom.
assert (parallel P Q A A1).
(* Goal: Col A P Y *)
(* Goal: False *)
apply (perp_perp_para P Q Y P A A1);auto with Geom.
unfold parallel, S4 in *.
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_signed_areas.
IsoleVar (S P A Q) H12;rewrite H12.
(* Goal: @eq F (Fdiv (Fplus (Fopp (DSeg W Y)) (DSeg W S)) (DSeg W S)) (Fminus F1 r) *)
(* Goal: @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
IsoleVar (S P B Q) H9;rewrite H9.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring.
(* Goal: @eq F (Fdiv (S A U V) (S4 C U Y V)) (Fdiv (S A U V) (S C U V)) *)
unfold S4.
replace (A1**B1) with (A1**P + P**B1).
2:apply chasles.
assert (~ (Col P Q Y)).
(* Goal: forall _ : @eq F (DSeg A Y) (DSeg C D), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
intro.
rewrite H5 in H1.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
IsoleVar r H1.
replace (0/ Py P Q P) with 0 in H1.
(* Goal: False *)
intuition.
(* Goal: @eq F (Fmult (Fdiv (DSeg C D) (DSeg A U)) (DSeg A U)) (DSeg C D) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
field;auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.

replace ((A1 ** P + P ** B1) / P ** Y) with (- (P**A1 / P**Y) + P ** B1/ P**Y).
(* Goal: @eq F (Fmult (Fdiv (DSeg C D) (DSeg A U)) (DSeg A U)) (DSeg C D) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
2:uniformize_dir_seg;field;auto with Geom.
rewrite (A6 P A1 Y Q H).
rewrite (A6 P B1 Y Q H).
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_signed_areas.
(* Goal: Col A P Y *)
(* Goal: False *)
field;solve_conds;auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: False *)
unfold on_foot in *.
use HA1.
use HB1.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: False *)
unfold on_foot in *.
use HA1.
use HB1.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: False *)
unfold on_foot in *.
use HA1.
use HB1.
assert (Col P A1 B1).
(* Goal: Col A P Y *)
(* Goal: False *)
apply (col_trans_1 P Y A1 B1 H11);auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.

(* Goal: @eq F (Fdiv (Py A P Q) (Py4 C P Y Q)) (Fdiv (Py A P Q) (Py C P Q)) *)
unfold Py4.
(* Goal: False *)
unfold on_foot in *.
use HA1.
use HB1.
unfold perp, Py4 in *.
IsoleVar (Py A1 P Y) H3.
IsoleVar (Py B1 P Y) H5.
rewrite H3, H5.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring.

(* ** *)
assert (T:=herron_qin P Q Y).
unfold perp, Py4 in H2.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
replace (Py Q P Y) with 0 in T
 by (replace (Py Q P Y) with (Py Y P Q) by auto with Geom;auto).
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
assert (Py Y P Y = (2*2)*r* S P Q Y).
IsoleVar r H1.
(* Goal: @eq F (Fplus (Fmult (Fdiv (Py P U V) (Py U V U)) (S V A B)) (Fmult (Fdiv (DSeg V Y) (DSeg V U)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
rewrite H1.
(* Goal: @eq F (Fdiv (Fplus (Fplus (Fplus (Fplus (Fmult (Fopp (DSeg A C)) (Fopp (DSeg A C))) (Fmult (DSeg A C) (DSeg A C))) (Fminus (Fplus (Fmult (Fopp (DSeg A C)) (Fopp (DSeg A C))) (Fmult (DSeg A B) (DSeg A B))) (Fmult (Fopp (DSeg B C)) (Fopp (DSeg B C))))) (Fminus (Fplus (Fmult (Fopp (DSeg A B)) (Fopp (DSeg A B))) (Fmult (DSeg A C) (DSeg A C))) (Fmult (DSeg B C) (DSeg B C)))) (Fplus (Fmult (Fopp (DSeg A B)) (Fopp (DSeg A B))) (Fmult (DSeg A B) (DSeg A B)))) (Fmult (Fplus F1 F1) (Fplus F1 F1))) (Fdiv (Fplus (Fplus (Fopp (Fplus (Fmult (DSeg B C) (DSeg B C)) (Fmult (Fopp (DSeg B C)) (Fopp (DSeg B C))))) (Fmult (Fplus F1 F1) (Fplus (Fmult (DSeg A C) (DSeg A C)) (Fmult (Fopp (DSeg A C)) (Fopp (DSeg A C)))))) (Fmult (Fplus F1 F1) (Fplus (Fmult (DSeg A B) (DSeg A B)) (Fmult (Fopp (DSeg A B)) (Fopp (DSeg A B)))))) (Fmult (Fplus F1 F1) (Fplus F1 F1))) *)
(* Goal: not (@eq F (Fmult (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: not (@eq F (Fplus F1 F1) F0) *)
field_simplify_eq.
(* Goal: Col A P Y *)
(* Goal: False *)
2:auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
2:auto with Geom.
replace (2 * (2 * (2 * 2)) * S P Q Y * S P Q Y) with 
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
        ((2 * (2 * (2 * 2))) * (S P Q Y * S P Q Y)) by ring.
rewrite T.
(* Goal: forall (_ : @eq F (Py A B Y) (Fplus (Fmult r (Py A B S)) (Fmult (Fminus F1 r) (Py A B W)))) (_ : @eq F (Fplus (Py U B A) (Py S B A)) (Fplus (Py V B A) (Py W B A))), @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
uniformize_pys.
(* Goal: not (@eq F (Fmult (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: not (@eq F (Py P Q P) F0) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
field;solve_conds.
replace (Py A B Y) with (Py A B P - Py4 B P A Y).
IsoleVar (Py4 B P A Y) H3.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
rewrite H3.
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
rewrite H5.
(* Goal: @eq F F1 (Fdiv (Py4 C P D Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
field.
(* Goal: Col A P Y *)
(* Goal: False *)
2:auto with Geom.
(* Goal: forall _ : @eq F (DSeg A Y) (DSeg C D), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
intro.
(* Goal: Col A P Y *)
(* Goal: False *)
assert (Col Y P Q) by auto with Geom.
rewrite col_pyth in H2 by assumption.
IsoleVar (P**Q) H2.
(* Goal: Col A P Y *)
(* Goal: False *)
2:solve_conds;auto with Geom.
replace (0 / (2 * P ** Y)) with (0) in H2.
(* Goal: Col A P Y *)
(* Goal: False *)
2:field;solve_conds;auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
assert (P=Q) by auto with Geom.
(* Goal: False *)
intuition.

(* Goal: Col A P Y *)
(* Goal: False *)
replace (Py4 B P A Y) with (- Py4 Y B P A) by auto with Geom.

unfold  Py4.
(* Goal: forall (_ : @eq F (Py A B Y) (Fplus (Fmult r (Py A B S)) (Fmult (Fminus F1 r) (Py A B W)))) (_ : @eq F (Fplus (Py U B A) (Py S B A)) (Fplus (Py V B A) (Py W B A))), @eq F (Py A B Y) (Fplus (Py A B W) (Fmult r (Fminus (Py A B V) (Py A B U)))) *)
uniformize_pys.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring.
Qed.

Theorem elim_py_on_perp_d_middle :
forall A B U V Y : Point, forall r: F,
on_perp_d Y U V r ->
Py A Y B = Py A U B + r * r * Py U V U - (2+2)*r*(S A U V + S B U V).
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
rename U into P.
rename V into Q.
replace (Py A Y B) with (Py A P B - Py A P Y - Py B P Y + Py Y P Y)
       by (unfold Py; uniformize_dir_seg;basic_simpl;ring).
rewrite (elim_py_on_perp_d_right A P P Q Y r H).
rewrite (elim_py_on_perp_d_right B P P Q Y r H).
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
unfold on_perp_d in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
assert (T:=herron_qin P Q Y).
unfold perp in H2.
unfold Py4 in H2.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: Col A P Y *)
(* Goal: False *)
replace (Py Q P Y) with (Py Y P Q) in * by auto with Geom.
rewrite H2 in T.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: Col A P Y *)
(* Goal: False *)
replace (Py P Y P) with (Py Y P Y) in  * by auto with Geom.
IsoleVar (Py Y P Y) T.
(* Goal: Col A P Y *)
(* Goal: False *)
2:auto with Geom.
IsoleVar r H1.
(* Goal: @eq F (Fplus (Fmult (Fdiv (Py P U V) (Py U V U)) (S V A B)) (Fmult (Fdiv (DSeg V Y) (DSeg V U)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
rewrite H1.
rewrite T.
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_signed_areas.
(* Goal: not (@eq F (Fmult (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: not (@eq F (Py P Q P) F0) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
field;solve_conds.
auto with field_hints.
(* Goal: not (@eq F (Fmult (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: not (@eq F (Py P Q P) F0) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
solve_conds.
auto with field_hints.
Qed.

(* elimination of area for euclidean constructions *)

Theorem elim_area_on_perp_d :
forall A B U V Y : Point, forall r: F,
on_perp_d Y U V r ->
S A B Y = S A B U - r / (2+2)  * Py4 U A V B.
Proof.
intros A B U V Y r.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.

(* Goal: Col A P Y *)
(* Goal: False *)
assert (S A B Y = S A B U + S A U Y + S U B Y) by auto with Geom.
(* Goal: @eq F (Fopp (S A P Y)) F0 *)
(* Goal: False *)
(* Goal: @eq F (S Y P A) F0 *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: not (@eq Point Y P) *)
(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (S P Y Q) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
rewrite H0.

assert (Hyuv :~ Col Y U V).
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
unfold on_perp_d in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.

(* Goal: forall _ : @eq F (DSeg A Y) (DSeg C D), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
intro.
(* Goal: Col A P Y *)
(* Goal: False *)
assert (Col U V Y) by auto with Geom.
rewrite H4 in H2.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
IsoleVar r H2.
replace (0 / Py U V U) with 0 in H2.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
2:field;auto.
(* Goal: Col A P Y *)
(* Goal: False *)
2:auto with Geom.
(* Goal: False *)
intuition.

elim (proj_ex A U V).
intros A1 HA1.
(* Goal: False *)
2:unfold on_perp_d in H;intuition.

assert (S U A Y = Py A U V / Py U V U * S U V Y).

assert (S U A Y / S U  V Y = S U A1 Y / S U V Y).
replace (S U A Y) with (S U A1 Y).
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.

(* Goal: False *)
unfold on_foot in *.
use HA1.
unfold on_perp_d in *.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
assert (parallel A1 A Y U).
(* Goal: Col A P Y *)
(* Goal: False *)
apply (perp_perp_para A1 A U V Y U);auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
assert (parallel Y U A1 A) by auto with Geom.
unfold parallel, S4 in H7.
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_signed_areas.
IsoleVar (S Y A1 U) H7.
rewrite H7.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring.

assert ( S U A1 Y / S U V Y = U**A1 / U**V).

rewrite (A6 U A1 V Y).
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_signed_areas.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
unfold on_perp_d in H.
use H;auto.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
unfold on_perp_d in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
(* Goal: False *)
unfold on_foot in *.
use HA1.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.

assert (U**A1 / U**V = Py A1 U V / Py U V U).
rewrite col_pyth.
(* Goal: @eq F (S C U V) (Fplus (Fdiv (Fmult (Py P U V) (S C U V)) (Py U V U)) (Fdiv (Fmult (Py P V U) (S C U V)) (Py U V U))) *)
unfold Py.
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_dir_seg.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
replace (U ** V * U ** V + U ** V * U ** V) with (2*U**V*U**V) by ring.
(* Goal: Col A P Y *)
(* Goal: False *)
field;solve_conds;unfold on_perp_d in *;auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
unfold on_perp_d in *;use H;auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
unfold on_foot in *;use HA1;auto with Geom.
assert (Py A1 U V = Py A U V).

(* Goal: False *)
unfold on_foot in *.
use HA1.
unfold perp, Py4 in H4.
IsoleVar (Py A1 U V) H4.
(* Goal: @eq F (Fopp (S P Q Y)) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: not (@eq F (Fplus (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
rewrite H4.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring.

rewrite H2 in H1.
rewrite H3 in H1.
rewrite H4 in H1.
IsoleVar (S U A Y) H1.
(* Goal: @eq F (Fplus (Fmult (Fdiv (Py P U V) (Py U V U)) (S V A B)) (Fmult (Fdiv (DSeg V Y) (DSeg V U)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
rewrite H1.
(* Goal: @eq F F1 (Fdiv (Py4 C P D Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
field.
unfold on_perp_d in *.
(* Goal: False *)
intuition.

(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.

(* cases B *)
assert (S U B Y = Py B U V / Py U V U * S U V Y).

elim (proj_ex B U V).
intros B1 HB1.
(* Goal: False *)
2:unfold on_perp_d in H;intuition.

assert (S U B Y / S U  V Y = S U B1 Y / S U V Y).
replace (S U B Y) with (S U B1 Y).
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.

(* Goal: False *)
unfold on_foot in *.
use HB1.
unfold on_perp_d in *.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
assert (parallel B1 B Y U).
(* Goal: Col A P Y *)
(* Goal: False *)
apply (perp_perp_para B1 B U V Y U);auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
assert (parallel Y U B1 B) by auto with Geom.
unfold parallel, S4 in H8.
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_signed_areas.
IsoleVar (S Y B1 U) H8.
rewrite H8.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring.

assert ( S U B1 Y / S U V Y = U**B1 / U**V).

rewrite (A6 U B1 V Y).
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_signed_areas.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
unfold on_perp_d in H.
use H;auto.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
unfold on_perp_d in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
(* Goal: False *)
unfold on_foot in *.
use HB1.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.

assert (U**B1 / U**V = Py B1 U V / Py U V U).
rewrite col_pyth.
(* Goal: @eq F (S C U V) (Fplus (Fdiv (Fmult (Py P U V) (S C U V)) (Py U V U)) (Fdiv (Fmult (Py P V U) (S C U V)) (Py U V U))) *)
unfold Py.
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_dir_seg.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
replace (U ** V * U ** V + U ** V * U ** V) with (2*U**V*U**V) by ring.
(* Goal: Col A P Y *)
(* Goal: False *)
field;solve_conds;unfold on_perp_d in *;auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
unfold on_perp_d in *;use H;auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
unfold on_foot in *;use HB1;auto with Geom.
assert (Py B1 U V = Py B U V).

(* Goal: False *)
unfold on_foot in *.
use HB1.
unfold perp, Py4 in H5.
IsoleVar (Py B1 U V) H5.
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
rewrite H5.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring.

rewrite H3 in H2.
rewrite H4 in H2.
rewrite H5 in H2.
IsoleVar (S U B Y) H2.
rewrite H2.
(* Goal: @eq F F1 (Fdiv (Py4 C P D Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
field.
unfold on_perp_d in *.
(* Goal: False *)
intuition.

(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.

(* *** *)
assert (S U A Y = r / (2+2) * Py A U V).
(* Goal: @eq F (Fplus (Fmult (Fdiv (Py P U V) (Py U V U)) (S V A B)) (Fmult (Fdiv (DSeg V Y) (DSeg V U)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
rewrite H1.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
unfold on_perp_d in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
IsoleVar  (S U V Y) H4.
(* Goal: @eq F (Fopp (S P Q Y)) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: not (@eq F (Fplus (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
rewrite H4.
(* Goal: not (@eq F (Fmult (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: not (@eq F (Py P Q P) F0) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
field;solve_conds.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
replace (2+2) with (2*2) by ring.
(* Goal: not (@eq F (Fmult (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: not (@eq F (Py P Q P) F0) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
solve_conds.
assert (S U B Y = r / (2+2) * Py B U V).
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
unfold on_perp_d in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
rewrite H2.
IsoleVar  (S U V Y) H5.
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
rewrite H5.
(* Goal: not (@eq F (Fmult (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: not (@eq F (Py P Q P) F0) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
field;solve_conds.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
replace (2+2) with (2*2) by ring.
(* Goal: not (@eq F (Fmult (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: not (@eq F (Py P Q P) F0) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
solve_conds.

(* Goal: Col A P Y *)
(* Goal: False *)
replace (S A U Y) with (- S U A Y) by auto with Geom.
rewrite H3, H4.
replace (Py4 U A V B) with( Py A U V - Py B U V).
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring.
symmetry.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
replace ( Py A U V - Py B U V) with  (Py4 A U B V) by auto.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
Qed.

Theorem elim_py_on_perp_d_left_right :
forall B U V Y : Point, forall r: F,
on_perp_d Y U V r ->
Py Y B Y = Py U B U - (2 + 2) * r * S U V B -
(2 + 2) * r * (0 - r / (2 + 2) * Py U V U + S U V B).
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: @eq F (Py Y B Y) (Fminus (Fminus (Py U B U) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S U V B))) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (Fplus (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py U V U))) (S U V B)))) *)
rewrite (elim_py_on_perp_d_right Y B U V Y r H).
(* Goal: Col A P Y *)
(* Goal: False *)
replace (Py Y B U) with (Py U B Y) by auto with Geom.
(* Goal: @eq F (Fminus (Py U B Y) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 U Y V B))) (Fminus (Fminus (Py U B U) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S U V B))) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (Fplus (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py U V U))) (S U V B)))) *)
rewrite (elim_py_on_perp_d_right U B U V Y r H).
(* Goal: @eq F (Fdiv (S A U V) (S4 C U Y V)) (Fdiv (S A U V) (S C U V)) *)
unfold S4.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: Col A P Y *)
(* Goal: False *)
replace (S U Y V) with (S V U Y) by auto with Geom.
(* Goal: @eq F (Fminus (Fminus (Py U B U) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S U V B))) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (Fplus (S V U Y) (S U V B)))) (Fminus (Fminus (Py U B U) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S U V B))) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (Fplus (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py U V U))) (S U V B)))) *)
rewrite (elim_area_on_perp_d V U U V Y r H).
(* Goal: @eq F (Fdiv (Py A P Q) (Py4 C P Y Q)) (Fdiv (Py A P Q) (Py C P Q)) *)
unfold Py4.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
Qed.


Theorem elim_area_on_foot :
forall A B P U V Y : Point,
 on_foot Y P U V ->
 S A B Y = (Py P U V * S A B V + Py P V U * S A B U) / (Py U V U).
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: False *)
unfold on_foot in *.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: Col A P Y *)
(* Goal: False *)
replace (S A B Y) with (S Y A B) by auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
rewrite (l2_9 A B U V Y) by auto with Geom.
(* Goal: @eq F (Fplus (Fmult (Fdiv (DSeg U Y) (DSeg U V)) (S V A B)) (Fmult (Fdiv (DSeg Y V) (DSeg U V)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
assert (U**Y/U**V = Py P U V / Py U V U).
(* Goal: @eq F (Fdiv (DSeg V Y) (DSeg V U)) (Fdiv (Py P V U) (Py V U V)) *)
(* Goal: @eq F (Fplus (Fmult (Fdiv (DSeg U Y) (DSeg U V)) (S V A B)) (Fmult (Fdiv (DSeg Y V) (DSeg U V)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
apply l_24_c_on_foot.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
unfold on_foot;auto.
(* Goal: @eq F (Fplus (Fmult (Fdiv (DSeg U Y) (DSeg U V)) (S V A B)) (Fmult (Fdiv (DSeg Y V) (DSeg U V)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
assert (V**Y/V**U = Py P V U / Py V U V).
(* Goal: @eq F (Fdiv (DSeg V Y) (DSeg V U)) (Fdiv (Py P V U) (Py V U V)) *)
(* Goal: @eq F (Fplus (Fmult (Fdiv (DSeg U Y) (DSeg U V)) (S V A B)) (Fmult (Fdiv (DSeg Y V) (DSeg U V)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
apply l_24_c_on_foot.
(* Goal: Col A P Y *)
(* Goal: False *)
unfold on_foot;auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
replace (Y ** V / U ** V) with (V**Y/V**U) by auto with Geom.
(* Goal: @eq F (Fplus (Fmult (Fdiv (DSeg U Y) (DSeg U V)) (S V A B)) (Fmult (Fdiv (DSeg V Y) (DSeg V U)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
rewrite H.
(* Goal: @eq F (Fplus (Fmult (Fdiv (Py P U V) (Py U V U)) (S V A B)) (Fmult (Fdiv (DSeg V Y) (DSeg V U)) (S U A B))) (Fdiv (Fplus (Fmult (Py P U V) (S A B V)) (Fmult (Py P V U) (S A B U))) (Py U V U)) *)
rewrite H1.
(* Goal: Col A P Y *)
(* Goal: False *)
replace (Py V U V) with (Py U V U) by auto with Geom.
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_signed_areas.
(* Goal: @eq F (Fmult (Fdiv (DSeg C D) (DSeg A U)) (DSeg A U)) (DSeg C D) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
field;auto with Geom.
Qed.

Theorem elim_area_on_foot_invariant :
forall A B P U V Y : Point,
 on_foot Y P U V ->
 Py U V U <> 0.
Proof.
(* Goal: forall (_ : Point) (_ : Point) (P U V Y : Point) (_ : on_foot Y P U V), not (@eq F (Py U V U) F0) *)
exact elim_py_on_foot_right_invariant.
Qed.

(* elimination of ratios for euclidean constructions *)
(* the condition A<>Y is required *)

Theorem elim_ratio_on_foot_a :
forall Y P U V A C D : Point,
on_foot Y P U V ->
Col A U V ->
parallel A Y C D ->
C <> D ->
A <> Y ->
A**Y / C**D = Py4 P C A D / Py C D C.
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.

(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
cases_equality A U.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
subst U.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
cases_equality A V.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
subst V.
(* Goal: @eq F (Fdiv (DSeg A P) (DSeg C D)) (Fdiv (S A U V) (Fplus (S C U D) (S C D V))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (S A U V) (S4 C U D V)) *)
unfold on_foot in H.
(* Goal: False *)
use H;intuition.
(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (Fminus (S P P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
clear H0.
(* Goal: @eq F (Fdiv (DSeg A P) (DSeg C D)) (Fdiv (S A U V) (Fplus (S C U D) (S C D V))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (S A U V) (S4 C U D V)) *)
unfold on_foot in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.

(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
pose (d := C**D/A**V).
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
assert ({T : Point | Col T A V /\ A ** T = d * A**V}).
(* Goal: @sig Point (fun T : Point => and (Col T A V) (@eq F (DSeg A T) (Fmult d (DSeg A V)))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
apply (on_line_dex A V);assumption.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
elim H;intros T HT; clear H.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
use HT.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
unfold d in H5.

(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
assert (A**T = C**D).
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
rewrite H5.
(* Goal: @eq F (Fmult (Fdiv (DSeg C D) (DSeg A U)) (DSeg A U)) (DSeg C D) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
field;auto with Geom.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
rewrite <- H8.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A T)) (Fdiv (Py4 P C A D) (Py C D C)) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
clear H5.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A T)) (Fdiv (Py4 P C A D) (Py C D C)) *)
rewrite ( l_24_b A T P Y).
replace (2 * A ** T * A ** T) with (Py A T A)
 by (unfold Py;basic_simpl;uniformize_dir_seg;ring).
replace (Py A T A) with (Py C D C) by
(unfold Py;
uniformize_dir_seg;
rewrite H8;
ring).
(* Goal: @eq F (Fdiv (Py P A T) (Py C D C)) (Fdiv (Py4 P C A D) (Py C D C)) *)
(* Goal: Col A Y T *)
(* Goal: perp A T P Y *)
(* Goal: not (@eq Point A T) *)
replace (Py P A T) with (Py4 P C A D).
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
rewrite (l3_8_a A T D C P);auto.

(* Goal: Col A P Y *)
(* Goal: False *)
apply parallel_side_eq_weak_weak_weak_para;auto with Geom.
(* Goal: perp A T P Y *)
(* Goal: not (@eq Point A T) *)
assert (Col A Y T).
(* Goal: Col A P Y *)
(* Goal: False *)
apply (col_trans_1 A V Y T H4); auto with Geom.

(* Goal: parallel A T C D *)
(* Goal: Col A Y T *)
(* Goal: perp A T P Y *)
(* Goal: not (@eq Point A T) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
cut ( parallel C D A T).
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
apply (parallel_transitivity C D A Y A T);auto with Geom.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
unfold parallel, S4;basic_simpl.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.

(* Goal: Col A P Y *)
(* Goal: False *)
apply (col_trans_1 A V Y T H7);auto with Geom.

(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
apply (perp_para_perp A V P Y A T); auto.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
unfold parallel, S4;basic_simpl.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
assert (Col A V T);auto with Geom;auto.

(* Goal: not (@eq F (Py D' P Q) F0) *)
(* Goal: on_inter_line_perp Y P A D' P Q *)
unfold not;intro.
(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A D')) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
subst.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A D')) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
assert (C=D).
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: False *)
intuition.

(* case A<>U *)

(* Goal: @eq F (Fdiv (DSeg A P) (DSeg C D)) (Fdiv (S A U V) (Fplus (S C U D) (S C D V))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (S A U V) (S4 C U D V)) *)
unfold on_foot in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
pose (d := C**D/A**U).
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
assert ({T : Point | Col T A U /\ A ** T = d * A**U}).
(* Goal: @sig Point (fun T : Point => and (Col T A U) (@eq F (DSeg A T) (Fmult d (DSeg A U)))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
apply (on_line_dex A U);assumption.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
elim H;intros T HT; clear H.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
use HT.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
unfold d in H6.

(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
assert (A**T = C**D).
(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (S P Y Q) (S4 C P D Q)) *)
(* Goal: not (@eq F (Py P Q P) F0) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
rewrite H6.
(* Goal: @eq F (Fmult (Fdiv (DSeg C D) (DSeg A U)) (DSeg A U)) (DSeg C D) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
field;auto with Geom.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py4 P C A D) (Py C D C)) *)
rewrite <- H9.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A T)) (Fdiv (Py4 P C A D) (Py C D C)) *)
clear H6.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A T)) (Fdiv (Py4 P C A D) (Py C D C)) *)
rewrite ( l_24_b A T P Y).
replace (2 * A ** T * A ** T) with (Py A T A)
 by (unfold Py;basic_simpl;uniformize_dir_seg;ring).
replace (Py A T A) with (Py C D C) by
(unfold Py;
uniformize_dir_seg;
rewrite H9;
ring).
(* Goal: @eq F (Fdiv (Py P A T) (Py C D C)) (Fdiv (Py4 P C A D) (Py C D C)) *)
(* Goal: Col A Y T *)
(* Goal: perp A T P Y *)
(* Goal: not (@eq Point A T) *)
replace (Py P A T) with (Py4 P C A D).
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
rewrite (l3_8_a A T D C P);auto.

(* Goal: perp A T P Y *)
(* Goal: not (@eq Point A T) *)
assert (Col U Y A).
(* Goal: Col A P Y *)
(* Goal: False *)
apply (col_trans_1 U V Y A H8);auto with Geom.
(* Goal: perp A T P Y *)
(* Goal: not (@eq Point A T) *)
assert (Col U Y T).
(* Goal: Col A P Y *)
(* Goal: False *)
apply (col_trans_1 U A Y T);auto with Geom.
(* Goal: perp A T P Y *)
(* Goal: not (@eq Point A T) *)
assert (Col A Y T).
(* Goal: Col A P Y *)
(* Goal: False *)
apply (col_trans_1 A U Y T H4); auto with Geom.
(* Goal: weak_3_parallelogram A T D C *)
(* Goal: Col A Y T *)
(* Goal: perp A T P Y *)
(* Goal: not (@eq Point A T) *)
assert (parallel C D T A).
(* Goal: Col A P Y *)
(* Goal: False *)
apply (parallel_transitivity C D A Y T A);auto with Geom.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
unfold parallel;basic_simpl.
(* Goal: Col A P Y *)
(* Goal: False *)
assert (Col A T Y) by auto with Geom.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.

(* Goal: Col A P Y *)
(* Goal: False *)
apply parallel_side_eq_weak_weak_weak_para;auto with Geom.

(* Goal: perp A T P Y *)
(* Goal: not (@eq Point A T) *)
assert (Col U Y A).
(* Goal: Col A P Y *)
(* Goal: False *)
apply (col_trans_1 U V Y A H8);auto with Geom.
(* Goal: perp A T P Y *)
(* Goal: not (@eq Point A T) *)
assert (Col U Y T).
(* Goal: Col A P Y *)
(* Goal: False *)
apply (col_trans_1 U A Y T);auto with Geom.
(* Goal: perp A T P Y *)
(* Goal: not (@eq Point A T) *)
assert (Col A Y T).
(* Goal: Col A P Y *)
(* Goal: False *)
apply (col_trans_1 A U Y T H4); auto with Geom.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.

(* Goal: perp A T P Y *)
(* Goal: not (@eq Point A T) *)
assert (Col U Y A).
(* Goal: Col A P Y *)
(* Goal: False *)
apply (col_trans_1 U V Y A H8);auto with Geom.
(* Goal: perp A T P Y *)
(* Goal: not (@eq Point A T) *)
assert (Col U Y T).
(* Goal: Col A P Y *)
(* Goal: False *)
apply (col_trans_1 U A Y T);auto with Geom.
(* Goal: perp A T P Y *)
(* Goal: not (@eq Point A T) *)
assert (Col A Y T).
(* Goal: Col A P Y *)
(* Goal: False *)
apply (col_trans_1 A U Y T H4); auto with Geom.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
(* Goal: perp A T P Y *)
(* Goal: not (@eq Point A T) *)
assert (Col U V T).
(* Goal: Col A P Y *)
(* Goal: False *)
apply (col_trans_1 U A V T);auto with Geom.
(* Goal: perp A T P Y *)
(* Goal: not (@eq Point A T) *)
assert (parallel U V A T).
(* Goal: parallel A Y P A *)
(* Goal: parallel A P C D *)
(* Goal: not (@eq Point A P) *)
unfold parallel, S4.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: @eq F (Fplus (S U A V) (S U V T)) F0 *)
(* Goal: perp A T P Y *)
(* Goal: not (@eq Point A T) *)
replace (S U A V) with 0.
(* Goal: @eq F (Fplus F0 (S U V T)) F0 *)
(* Goal: @eq F F0 (S U A V) *)
(* Goal: perp A T P Y *)
(* Goal: not (@eq Point A T) *)
rewrite H12.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring.
(* Goal: Col A P Y *)
(* Goal: False *)
assert (Col U A V) by auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
symmetry;auto with Geom.

(* Goal: perp A T P Y *)
(* Goal: not (@eq Point A T) *)
cut (perp A T Y P).
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
apply (perp_para_perp U V Y P A T);auto with Geom.

(* Goal: not (@eq F (Py D' P Q) F0) *)
(* Goal: on_inter_line_perp Y P A D' P Q *)
unfold not;intro.
(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A D')) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
subst.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A D')) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
assert (C=D).
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: False *)
intuition.
Qed.

Theorem elim_ratio_on_foot_a_invariant : forall C D,
C<>D -> Py C D C <> 0.
Proof.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
Qed.

Theorem elim_ratio_on_foot_spec_a :
forall Y P U V A C D : Point,
on_foot Y P U V ->
Col A U V ->
parallel A Y C Y ->
C <> Y ->
A <> Y ->
A**Y / C**Y = (Py P U V * Py4 P C A V + Py P V U * Py4 P C A U) /
(Py P U V * Py C V C + Py P V U * Py C U C - Py P U V * Py P V U).
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
rewrite (elim_ratio_on_foot_a Y P U V) by auto.
(* Goal: @eq F (Fdiv (Py4 P C A Y) (Py C Y C)) (Fdiv (Fplus (Fmult (Py P U V) (Py4 P C A V)) (Fmult (Py P V U) (Py4 P C A U))) (Fminus (Fplus (Fmult (Py P U V) (Py C V C)) (Fmult (Py P V U) (Py C U C))) (Fmult (Py P U V) (Py P V U)))) *)
assert (T:= (elim_ratio_on_foot_a_invariant C Y H2)).

(* Goal: @eq F (Fdiv (Py A P Q) (Py4 C P Y Q)) (Fdiv (Py A P Q) (Py C P Q)) *)
unfold Py4.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
rewrite (elim_py_on_foot_right P C P U V) in * by auto.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
rewrite (elim_py_on_foot_right A C P U V) in * by auto.
(* Goal: @eq F (Fdiv (Fminus (Fdiv (Fplus (Fmult (Py P U V) (Py P C V)) (Fmult (Py P V U) (Py P C U))) (Py U V U)) (Fdiv (Fplus (Fmult (Py P U V) (Py A C V)) (Fmult (Py P V U) (Py A C U))) (Py U V U))) (Py C Y C)) (Fdiv (Fplus (Fmult (Py P U V) (Fminus (Py P C V) (Py A C V))) (Fmult (Py P V U) (Fminus (Py P C U) (Py A C U)))) (Fminus (Fplus (Fmult (Py P U V) (Py C V C)) (Fmult (Py P V U) (Py C U C))) (Fmult (Py P U V) (Py P V U)))) *)
rewrite (pyth_simpl_4 C Y) in *.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
rewrite (elim_py_on_foot_left_right C P U V Y) in * by auto.
replace (((Py P U V * Py P C V + Py P V U * Py P C U) / Py U V U -
 (Py P U V * Py A C V + Py P V U * Py A C U) / Py U V U) /
((Py P U V * Py P U V * Py V C V + Py P U V * Py P V U * Py V C U +
  Py P U V * Py P V U * Py U C V + Py P V U * Py P V U * Py U C U) /
 (Py U V U * Py U V U)))
with 
(((Py P U V * Py P C V + Py P V U * Py P C U) -
 (Py P U V * Py A C V + Py P V U * Py A C U) ) /
((Py P U V * Py P U V * Py V C V + Py P U V * Py P V U * Py V C U +
  Py P U V * Py P V U * Py U C V + Py P V U * Py P V U * Py U C U) /
 ( Py U V U))) in *.
replace (Py P U V * Py P C V + Py P V U * Py P C U -
 (Py P U V * Py A C V + Py P V U * Py A C U))
with (Py P U V * Py P C V + Py P V U * Py P C U -
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
Py P U V * Py A C V - Py P V U * Py A C U) in * by ring.
replace (Py P U V * Py P C V + Py P V U * Py P C U - Py P U V * Py A C V -
 Py P V U * Py A C U)
with
(Py P U V * Py4 P C A V + Py P V U * Py4 P C A U) in * by (unfold Py4;ring).
replace ((Py P U V * Py P U V * Py V C V + Py P U V * Py P V U * Py V C U +
  Py P U V * Py P V U * Py U C V + Py P V U * Py P V U * Py U C U) / 
 Py U V U)
with (
 Py P U V * Py C V C +
Py P V U * Py C U C - Py P U V * Py P V U) in *.

(* Goal: @eq F (Fdiv (Py A P Q) (Py C P Q)) (Fdiv (Py A P Q) (Py C P Q)) *)
trivial.

(* Goal: @eq F (S C U V) (Fplus (Fdiv (Fmult (Py P U V) (S C U V)) (Py U V U)) (Fdiv (Fmult (Py P V U) (S C U V)) (Py U V U))) *)
unfold Py.
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_dir_seg.
(* Goal: @eq F F1 (Fdiv (Py4 C P D Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
field.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
replace(U ** V * U ** V + U ** V * U ** V)
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
with (2*U ** V * U ** V) by ring.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
unfold on_foot in H;use H.
(* Goal: Col A P Y *)
(* Goal: False *)
repeat (apply nonzeromult);auto with Geom.

(* Goal: @eq F F1 (Fdiv (Py4 C P D Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
field.
(* Goal: and (not (@eq F (Py U V U) F0)) (not (@eq F (Fplus (Fplus (Fplus (Fmult (Fmult (Py P U V) (Py P U V)) (Py V C V)) (Fmult (Fmult (Py P U V) (Py P V U)) (Py V C U))) (Fmult (Fmult (Py P U V) (Py P V U)) (Py U C V))) (Fmult (Fmult (Py P V U) (Py P V U)) (Py U C U))) F0)) *)
split.
(* Goal: @eq F (Fdiv (DSeg A P) (DSeg C D)) (Fdiv (S A U V) (Fplus (S C U D) (S C D V))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (S A U V) (S4 C U D V)) *)
unfold on_foot in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: not (@eq F (Fplus (Fplus (Fplus (Fmult (Fmult (Py P U V) (Py P U V)) (Py V C V)) (Fmult (Fmult (Py P U V) (Py P V U)) (Py V C U))) (Fmult (Fmult (Py P U V) (Py P V U)) (Py U C V))) (Fmult (Fmult (Py P V U) (Py P V U)) (Py U C U))) F0) *)
intro Ha.
(* Goal: False *)
rewrite Ha in *.
(* Goal: False *)
replace ( 0 / (Py U V U * Py U V U) ) with 0 in *.
(* Goal: False *)
intuition.
(* Goal: @eq F F1 (Fdiv (Py4 C P D Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
field.
(* Goal: @eq F (Fdiv (DSeg A P) (DSeg C D)) (Fdiv (S A U V) (Fplus (S C U D) (S C D V))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (S A U V) (S4 C U D V)) *)
unfold on_foot in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
Qed.

Theorem elim_ratio_on_foot_b :
forall Y P U V A C D : Point,
on_foot Y P U V ->
~ Col A U V ->
parallel A Y C D ->
C <> D ->
A**Y / C**D = S A U V / S4 C U D V.
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (S A U V) (S4 C U D V)) *)
cases_equality Y P.

(* Goal: False *)
(* Goal: not (@eq Point P Q) *)
(* Goal: parallel Y P P Q *)
(* Goal: @eq F (S Y P A) F0 *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: not (@eq Point Y P) *)
(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (S P Y Q) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
subst Y.
(* Goal: @eq F (Fdiv (S A U V) (S4 C U Y V)) (Fdiv (S A U V) (S C U V)) *)
unfold S4.
(* Goal: @eq F (Fdiv (DSeg A P) (DSeg C D)) (Fdiv (S A U V) (Fplus (S C U D) (S C D V))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (S A U V) (S4 C U D V)) *)
unfold on_foot in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: @eq F (Fdiv (DSeg A P) (DSeg C D)) (Fdiv (S A U V) (Fplus (S C U D) (S C D V))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (S A U V) (S4 C U D V)) *)
clear H3.
(* Goal: Col A P Y *)
(* Goal: False *)
eapply elim_length_ratio_inter_ll_1 with (P:=A) (Q:=P);auto with Geom.
(* Goal: inter_ll P P Y P Q *)
(* Goal: not (@eq F (S Y P Q) F0) *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
unfold inter_ll.
(* Goal: Col A P Y *)
(* Goal: False *)
repeat split;auto with Geom.
(* Goal: forall _ : @eq F (DSeg A Y) (DSeg C D), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
intro.
(* Goal: Col A P Y *)
(* Goal: False *)
assert (parallel V U P A) by auto with Geom.
(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (S A U V) (S4 C U D V)) *)
unfold parallel, S4 in H3.
(* Goal: Col A P Y *)
(* Goal: False *)
replace (S V P U) with (S P U V) in H3 by auto with Geom.
(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (S A U V) (S4 C U D V)) *)
rewrite H5 in H3.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (S A U V) (S4 C U D V)) *)
assert (Col A U V).
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: False *)
intuition.

(* Goal: Col A P Y *)
(* Goal: False *)
eapply elim_length_ratio_inter_ll_1 with (P:=P) (Q:=Y); auto with Geom.
(* Goal: inter_ll Y P Y U V *)
unfold inter_ll, on_foot in *.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: Col A P Y *)
(* Goal: False *)
repeat split; auto with Geom.
(* Goal: not (parallel P Y U V) *)
cut (~ parallel Y P U V).
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
apply perp_not_parallel; auto with Geom.
Qed.

Theorem elim_ratio_on_foot_spec_b :
forall Y P U V A C : Point,
on_foot Y P U V ->
~ Col A U V ->
parallel A Y C Y ->
C <> Y ->
A**Y / C**Y = S A U V / S C U V.
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (S A U V) (S C U V)) *)
rewrite (elim_ratio_on_foot_b Y P U V A C) by assumption.
(* Goal: @eq F (Fdiv (S A U V) (S4 C U Y V)) (Fdiv (S A U V) (S C U V)) *)
unfold S4.
(* Goal: Col A P Y *)
(* Goal: False *)
replace (S C Y V) with (S V C Y) by auto with Geom.
(* Goal: @eq F (Fdiv (S A U V) (Fplus (S C U Y) (S V C Y))) (Fdiv (S A U V) (S C U V)) *)
rewrite (elim_area_on_foot C U P U V Y) by assumption.
(* Goal: @eq F (Fdiv (S A U V) (Fplus (Fdiv (Fplus (Fmult (Py P U V) (S C U V)) (Fmult (Py P V U) (S C U U))) (Py U V U)) (S V C Y))) (Fdiv (S A U V) (S C U V)) *)
rewrite (elim_area_on_foot V C P U V Y) by assumption.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_signed_areas.
replace (Py P U V * S C U V / Py U V U + Py P V U * S C U V / Py U V U)
with (S C U V).
(* Goal: @eq F (Fdiv (Py A P Q) (Py C P Q)) (Fdiv (Py A P Q) (Py C P Q)) *)
trivial.
(* Goal: @eq F (S C U V) (Fplus (Fdiv (Fmult (Py P U V) (S C U V)) (Py U V U)) (Fdiv (Fmult (Py P V U) (S C U V)) (Py U V U))) *)
unfold Py.
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_dir_seg.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: @eq F F1 (Fdiv (Py4 C P D Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
field.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
replace (U ** V * U ** V + U ** V * U ** V) with (2*U ** V * U ** V) by ring.
(* Goal: not (@eq F (Fmult (Fmult (Fplus F1 F1) (DSeg U V)) (DSeg U V)) F0) *)
unfold on_foot in H;decompose [and] H.
(* Goal: Col A P Y *)
(* Goal: False *)
repeat (apply nonzeromult);auto with Geom.
Qed.


Theorem elim_ratio_on_foot_b_invariant :
forall Y P U V A C D : Point,
on_foot Y P U V ->
~ Col A U V ->
parallel A Y C D ->
C<>D ->
S4 C U D V <> 0.
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: forall _ : @eq F (DSeg A Y) (DSeg C D), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
intro.
(* Goal: Col A P Y *)
(* Goal: False *)
assert (parallel C D U V) by auto with Geom.
(* Goal: False *)
unfold on_foot in *.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
assert  (T:=parallel_transitivity A Y C D U V H2 H1 H4).
(* Goal: Col A P Y *)
(* Goal: False *)
assert (parallel U V A Y) by auto with Geom.
(* Goal: False *)
unfold parallel, S4 in H.
(* Goal: False *)
replace (S U V Y) with (0) in H.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: Col A P Y *)
(* Goal: False *)
assert (Col A U V) by auto with Geom.
(* Goal: False *)
intuition.
(* Goal: Col A P Y *)
(* Goal: False *)
assert (Col U V Y) by auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
Qed.

Theorem elim_ratio_on_perp_d_a_invariant :
  forall Y P Q A C D : Point, forall r: F,
  on_perp_d Y P Q r->
  Col A P Y  ->
  parallel A Y C D ->
  A<>Y ->
  C<>D ->
  S4 C P D Q <> 0.
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
unfold on_perp_d in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: forall _ : @eq F (DSeg A Y) (DSeg C D), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
intro.
(* Goal: Col A P Y *)
(* Goal: False *)
assert (parallel C D P Q) by auto with Geom.
(* Goal: False *)
clear H.
assert (T:=parallel_transitivity A Y C D P Q H3 H1 H7).

assert (parallel Y P P Q).
apply (parallel_transitivity Y P A Y P Q H2);
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
unfold parallel.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: Col A P Y *)
(* Goal: False *)
assert (Col Y A P) by auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
assert (~ perp Y P P Q).
apply (parallel_not_perp Y P P Q H).
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
2:auto.
(* Goal: False *)
2:intuition.
(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A D')) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
intro;subst.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
IsoleVar (Py P Q P) H5.
replace (0/r) with (0) in H5.
(* Goal: @eq F F1 (Fdiv (Py4 C P D Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
2:field.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
2:auto.
assert (P=Q).
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: False *)
intuition.
Qed.

Theorem elim_ratio_on_perp_d_a_aux :
 forall Y P Q A C D : Point, forall r: F,
on_perp_d Y P Q r->
Col A P Y  ->
parallel A Y C D ->
C<>D ->
A<>Y ->
A<>P ->
A**Y / C**D = (S A P Q -r/(2+2) * Py P Q P)/(S4 C P D Q).
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.




(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
rename H4 into Hap.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
assert (T:= (elim_ratio_on_perp_d_a_invariant Y P Q A C D r H H0 H1 H3 H2)).

(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
assert (Hr: r<> 0).
unfold on_perp_d in *;use H;auto.

replace  (A**Y) with (A**P + P**Y) by
  (auto with Geom).
(* Goal: @eq F (Fdiv (Fplus (DSeg A P) (DSeg P Y)) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
replace ((A ** P + P ** Y) / C ** D) with (A**P/C**D + P**Y/C**D) by (field;auto with Geom).
(* Goal: @eq F (Fplus (Fdiv (DSeg A P) (DSeg C D)) (Fdiv (DSeg P Y) (DSeg C D))) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
replace (A**P / C**D) with (S A P Q / S4 C P D Q).
(* Goal: @eq F (Fplus (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg P Y) (DSeg C D))) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
replace (P**Y / C**D) with (- r / (2+2) * Py P Q P / S4 C P D Q).
(* Goal: not (@eq F (Fmult (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: not (@eq F (Py P Q P) F0) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
field;solve_conds.

(* deux exprs *)



(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
assert (P**Y / C**D = S P Y Q / S4 C P D Q).
(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (S P Y Q) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
assert (Y ** P / C ** D = S Y P Q / S4 C P D Q).
(* Goal: @eq F (Fdiv (DSeg Y P) (DSeg C D)) (Fdiv (S Y P Q) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (S P Y Q) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
apply (elim_length_ratio_inter_ll_2 Y C D P A P Q P).
(* Goal: inter_ll P P Y P Q *)
(* Goal: not (@eq F (S Y P Q) F0) *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
unfold inter_ll.
(* Goal: Col A P Y *)
(* Goal: False *)
repeat split;auto with Geom.

(* Goal: forall _ : @eq F (DSeg A Y) (DSeg C D), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
intro.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
unfold on_perp_d in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.

(* Goal: False *)
(* Goal: @eq F (S Y P A) F0 *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: not (@eq Point Y P) *)
(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (S P Y Q) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
assert (parallel P Q P Y).
(* Goal: parallel P Q P Y *)
(* Goal: False *)
(* Goal: @eq F (S Y P A) F0 *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: not (@eq Point Y P) *)
(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (S P Y Q) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
apply (parallel_transitivity P Q P A P Y).

(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.

(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
(* Goal: parallel A Y P A *)
(* Goal: parallel A P C D *)
(* Goal: not (@eq Point A P) *)
unfold parallel, S4.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: @eq F (S P A Y) F0 *)
(* Goal: False *)
(* Goal: @eq F (S Y P A) F0 *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: not (@eq Point Y P) *)
(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (S P Y Q) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
unfold Col in H0.
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_signed_areas.
(* Goal: @eq F (Fopp (S A P Y)) F0 *)
(* Goal: False *)
(* Goal: @eq F (S Y P A) F0 *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: not (@eq Point Y P) *)
(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (S P Y Q) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
rewrite H0.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring.
(* Goal: Col A P Y *)
(* Goal: False *)
assert (parallel Y P P Q) by auto with Geom.
(* Goal: False *)
(* Goal: @eq F (S Y P A) F0 *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: not (@eq Point Y P) *)
(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (S P Y Q) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
apply (perp_not_parallel Y P P Q H7).
(* Goal: forall _ : @eq F (DSeg A Y) (DSeg C D), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
intro.
(* Goal: False *)
(* Goal: not (@eq Point P Q) *)
(* Goal: parallel Y P P Q *)
(* Goal: @eq F (S Y P A) F0 *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: not (@eq Point Y P) *)
(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (S P Y Q) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
subst Y.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (S P Y Q) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
IsoleVar r H6.
(* Goal: False *)
(* Goal: not (@eq F (Py P Q P) F0) *)
(* Goal: not (@eq Point P Q) *)
(* Goal: parallel Y P P Q *)
(* Goal: @eq F (S Y P A) F0 *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: not (@eq Point Y P) *)
(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (S P Y Q) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
replace (0 / Py P Q P) with 0 in H6.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
(* Goal: @eq F F1 (Fdiv (Py4 C P D Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
field.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
(* Goal: @eq F (S Y P A) F0 *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: not (@eq Point Y P) *)
(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (S P Y Q) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
unfold Col in *.
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_signed_areas.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
rewrite H0;ring.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.

(* Goal: parallel Y P C D *)
(* Goal: not (@eq Point Y P) *)
(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (S P Y Q) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
assert (parallel C D P Y).
(* Goal: Col A P Y *)
(* Goal: False *)
apply (parallel_transitivity C D A Y P Y); auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.

(* Goal: forall _ : @eq F (DSeg A Y) (DSeg C D), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
intro.
(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A D')) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
subst.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
unfold on_perp_d in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (S P Y Q) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
IsoleVar r H5.
(* Goal: False *)
(* Goal: not (@eq F (Py P Q P) F0) *)
(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (S P Y Q) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
replace (0 / Py P Q P) with 0 in H5.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
(* Goal: not (@eq F (Fmult (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: not (@eq F (Py P Q P) F0) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
field;solve_conds.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.

(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (S P Y Q) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
assert (parallel C D Y P).
(* Goal: parallel C D Y P *)
(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (S P Y Q) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
apply (parallel_transitivity C D A Y Y P H3).
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.

(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (S Q P Y) (S4 C P D Q)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
replace (P ** Y / C ** D) with (- ( Y**P / C**D)).
(* Goal: @eq F (Fopp (S P Q Y)) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: not (@eq F (Fplus (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
rewrite H4.
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_signed_areas.
(* Goal: @eq F F1 (Fdiv (Py4 C P D Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
field.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_dir_seg.
(* Goal: @eq F F1 (Fdiv (Py4 C P D Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
field.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.

(* Goal: @eq F (Fopp (S P Q Y)) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: not (@eq F (Fplus (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
rewrite H4.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
unfold on_perp_d in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (S P Y Q) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
IsoleVar r H6.
(* Goal: @eq F (Fdiv (Fmult (Fdiv (Fopp r) (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P)) (S4 C P D Q)) (Fdiv (S P Y Q) (S4 C P D Q)) *)
(* Goal: not (@eq F (Py P Q P) F0) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
rewrite H6.
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_signed_areas.
(* Goal: @eq F F1 (Fdiv (Py4 C P D Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
field.
(* Goal: Col A P Y *)
(* Goal: False *)
repeat split;auto with Geom.
(* Goal: not (@eq F (Fmult (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: not (@eq F (Py P Q P) F0) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
solve_conds.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.

(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
cases_equality A P.
(* Goal: False *)
(* Goal: @eq F (S A P Y) F0 *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel A P C D *)
(* Goal: not (@eq Point A P) *)
subst P.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: not (@eq F (Fmult (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: not (@eq F (Py P Q P) F0) *)
(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
field;solve_conds.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.

(* Goal: @eq F (Fdiv (S A P Q) (S4 C P D Q)) (Fdiv (DSeg A P) (DSeg C D)) *)
rewrite (elim_length_ratio_inter_ll_2 A C D P Y P Q P).
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
(* Goal: inter_ll P P Y P Q *)
(* Goal: not (@eq F (S Y P Q) F0) *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
unfold inter_ll.
(* Goal: Col A P Y *)
(* Goal: False *)
repeat split;auto with Geom.
(* Goal: not (parallel P Q P Y) *)
(* Goal: @eq F (S A P Y) F0 *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel A P C D *)
(* Goal: not (@eq Point A P) *)
apply perp_not_parallel.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
unfold on_perp_d in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
unfold on_perp_d in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
unfold on_perp_d in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: forall _ : @eq F (DSeg A Y) (DSeg C D), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
intro.
(* Goal: False *)
(* Goal: @eq F (S A P Y) F0 *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel A P C D *)
(* Goal: not (@eq Point A P) *)
subst P.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: False *)
(* Goal: @eq F (S A P Y) F0 *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel A P C D *)
(* Goal: not (@eq Point A P) *)
IsoleVar (Py Y Q Y) H6.
(* Goal: False *)
(* Goal: @eq F (S A P Y) F0 *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel A P C D *)
(* Goal: not (@eq Point A P) *)
replace (0/r) with 0 in H6 by (field;solve_conds).

(* Goal: False *)
(* Goal: @eq F (S A P Y) F0 *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel A P C D *)
(* Goal: not (@eq Point A P) *)
assert (Py Y Q Y <> 0).
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: False *)
intuition.

(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
(* Goal: parallel A P C D *)
(* Goal: not (@eq Point A P) *)
assert (parallel C D P A).
(* Goal: parallel C D P A *)
(* Goal: parallel A P C D *)
(* Goal: not (@eq Point A P) *)
apply (parallel_transitivity C D A Y P A H3).
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: parallel A Y P A *)
(* Goal: parallel A P C D *)
(* Goal: not (@eq Point A P) *)
unfold parallel, S4.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
Qed.

Theorem elim_ratio_on_perp_d_a :
 forall Y P Q A C D : Point, forall r: F,
on_perp_d Y P Q r->
Col A P Y  ->
parallel A Y C D ->
C<>D ->
A<>Y ->
A**Y / C**D = (S A P Q -r/(2+2) * Py P Q P)/(S4 C P D Q).
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
cases_equality A P.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
subst A.
(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (Fminus (S P P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
clear H0.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
unfold on_perp_d in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
replace (0 - r / (2 + 2) * Py P Q P) with (S Q P Y).
(* Goal: @eq F (Fdiv (DSeg P Y) (DSeg C D)) (Fdiv (S Q P Y) (S4 C P D Q)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
replace (P ** Y / C ** D) with (- (Y**P / C**D)).
rewrite (elim_length_ratio_inter_ll_1 Y C D  P Q P Y P).
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_signed_areas.
(* Goal: @eq F F1 (Fdiv (Py4 C P D Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
field.
(* Goal: not (@eq F (S4 C P D Q) F0) *)
(* Goal: inter_ll P P Y P Q *)
(* Goal: not (@eq F (S Y P Q) F0) *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
cut (~ parallel C D P Q).
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: not (parallel C D P Q) *)
(* Goal: inter_ll P P Y P Q *)
(* Goal: not (@eq F (S Y P Q) F0) *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
assert (perp C D P Q).
(* Goal: Col A P Y *)
(* Goal: False *)
apply (perp_para_perp P Y P Q C D);auto with Geom.
(* Goal: forall _ : @eq F (DSeg A Y) (DSeg C D), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
intro.
assert  (T:=parallel_not_perp C D P Q H6 H2 H0).
(* Goal: False *)
intuition.

(* Goal: inter_ll P P Y P Q *)
(* Goal: not (@eq F (S Y P Q) F0) *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
unfold inter_ll.
(* Goal: Col A P Y *)
(* Goal: False *)
repeat split;auto with Geom.
(* Goal: forall _ : @eq F (DSeg A Y) (DSeg C D), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
intro.
(* Goal: False *)
(* Goal: not (@eq F (S Y P Q) F0) *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
assert (T:=parallel_not_perp P Y P Q H H3 H0).
(* Goal: Col A P Y *)
(* Goal: False *)
assert (perp P Y P Q) by auto with Geom.
(* Goal: False *)
intuition.
(* Goal: forall _ : @eq F (DSeg A Y) (DSeg C D), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
intro.
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_signed_areas.
(* Goal: False *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
rewrite H in H4.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: False *)
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
assert (r * Py P Q P <> 0) by (apply nonzeromult;auto with Geom).
(* Goal: False *)
intuition.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
auto.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_dir_seg.
(* Goal: @eq F F1 (Fdiv (Py4 C P D Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
field.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_signed_areas.
(* Goal: @eq F (Fopp (S P Q Y)) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
IsoleVar (S P Q Y) H4.
(* Goal: @eq F (Fopp (S P Q Y)) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: not (@eq F (Fplus (Fplus F1 F1) (Fplus F1 F1)) F0) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
rewrite H4.
(* Goal: @eq F F1 (Fdiv (Py4 C P D Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
field.
(* Goal: Col A P Y *)
(* Goal: False *)
apply nonzeromult;auto with Geom.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
replace (2+2) with (2*2) by ring.
(* Goal: Col A P Y *)
(* Goal: False *)
apply nonzeromult;auto with Geom.

(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
apply elim_ratio_on_perp_d_a_aux;auto.
Qed.

Theorem elim_ratio_on_perp_d_spec_a :
 forall Y P Q A C : Point, forall r: F,
on_perp_d Y P Q r->
Col A P Y  ->
parallel A Y C Y ->
C<>Y ->
A<>Y ->
A**Y / C**Y = (S A P Q - r / (2 + 2) * Py P Q P) /
(S Q C P -r/(2+2) * Py P Q P).
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
rewrite (elim_ratio_on_perp_d_a Y P Q A C Y r); try assumption.
(* Goal: @eq F (Fdiv (S A U V) (S4 C U Y V)) (Fdiv (S A U V) (S C U V)) *)
unfold S4.
(* Goal: Col A P Y *)
(* Goal: False *)
replace (S C Y Q) with (S Q C Y) by auto with Geom.
rewrite (elim_area_on_perp_d C P P Q Y r) by assumption.
rewrite (elim_area_on_perp_d Q C P Q Y r) by assumption.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: @eq F (Fdiv (Py A P Q) (Py4 C P Y Q)) (Fdiv (Py A P Q) (Py C P Q)) *)
unfold Py4.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
uniformize_signed_areas.
replace (0 - r / (2 + 2) * (Py P C P - Py Q C P) + (S Q C P - r / (2 + 2) * Py P Q C))
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
with (S Q C P - r / (2 + 2) * (Py P C P - Py Q C P) - r / (2 + 2) * Py P Q C) by ring.
replace (Py P C P - Py Q C P) with (Py C P Q) by 
(unfold Py;uniformize_dir_seg;basic_simpl;ring).
replace (S Q C P - r / (2 + 2) * Py C P Q - r / (2 + 2) * Py P Q C) with 
(S Q C P -r/(2+2) * Py P Q P).
(* Goal: @eq F (S C U V) (Fplus (Fdiv (Fmult (Py P U V) (S C U V)) (Py U V U)) (Fdiv (Fmult (Py P V U) (S C U V)) (Py U V U))) *)
2:unfold Py.
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
2:uniformize_dir_seg.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
2:basic_simpl.
(* Goal: @eq F F1 (Fdiv (Py4 C P D Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
2:field.
(* Goal: Col A P Y *)
(* Goal: False *)
2:apply nonzeromult; auto with Geom.
(* Goal: @eq F (Fdiv (Py A P Q) (Py C P Q)) (Fdiv (Py A P Q) (Py C P Q)) *)
trivial.
Qed.

Lemma elim_ratio_on_perp_d_b_auxi : 
  forall A Y C D P Q : Point, 
  on_parallel_d Y A C D 1 ->
  Py C P Q - Py D P Q = Py A P Q - Py Y P Q.
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py A P Q) (Py Y P Q)) *)
replace (Py Y P Q) with (Py Q P Y) by apply pyth_sym.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py A P Q) (Py Q P Y)) *)
rewrite (elim_py_on_parallel_d_right Q P A C D Y 1) by assumption.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py A P Q) (Fplus (Py Q P A) (Fmult F1 (Fminus (Py Q P D) (Py Q P C))))) *)
replace (Py A P Q) with (Py Q P A) by apply pyth_sym.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py Q P A) (Fplus (Py Q P A) (Fmult F1 (Fminus (Py Q P D) (Py Q P C))))) *)
replace (Py Q P D) with (Py D P Q) by apply pyth_sym.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py Q P A) (Fplus (Py Q P A) (Fmult F1 (Fminus (Py D P Q) (Py Q P C))))) *)
replace (Py Q P C) with (Py C P Q) by apply pyth_sym.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring.
Qed.

Theorem elim_ratio_on_perp_d_b_aux :
 forall Y P Q A C D : Point, forall r: F,
 on_perp_d Y P Q r->
 ~ Col A P Y  ->
 parallel A Y C D ->
 C<>D -> C**D <>A**Y ->
 A**Y / C**D = Py A P Q / Py4 C P D Q.
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
unfold on_perp_d in H.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
assert (A<>Y).
(* Goal: not (@eq F (Py D' P Q) F0) *)
(* Goal: on_inter_line_perp Y P A D' P Q *)
unfold not;intro.
(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A D')) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
subst.
(* Goal: False *)
intuition.

(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
assert (T:=on_line_dex_spec_strong_f A Y C D H1 H4).

(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
elim T;intros D' HD'.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
clear T.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
decompose [and] HD'; clear HD'.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
rewrite <- H7.

(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A D')) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
assert (A<>D').
(* Goal: not (@eq F (Py D' P Q) F0) *)
(* Goal: on_inter_line_perp Y P A D' P Q *)
unfold not;intro.
(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A D')) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
subst.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A D')) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
assert (C=D).
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A D')) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
subst.
(* Goal: False *)
intuition.

(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A D')) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
assert (D'<>Y).
(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A D')) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
unfold not;intro;subst.
(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A D')) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
subst.
(* Goal: False *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A D')) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
rewrite H7 in H3.
(* Goal: False *)
intuition.

(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg A D')) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
rewrite (l_25_b P Q A D' Y H6 H9).
(* Goal: @eq F (Fdiv (Py A P Q) (Py4 A P D' Q)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: not (@eq F (Py D' P Q) F0) *)
(* Goal: on_inter_line_perp Y P A D' P Q *)
assert (Py4 A P D' Q = Py4 C P D Q).
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
apply l_27_b; auto.

(* Goal: @eq F (Fdiv (Py A P Q) (Py4 A P D' Q)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: not (@eq F (Py D' P Q) F0) *)
(* Goal: on_inter_line_perp Y P A D' P Q *)
rewrite H10.
(* Goal: @eq F (Fdiv (Py A P Q) (Py4 C P D Q)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: not (@eq F (Py D' P Q) F0) *)
(* Goal: on_inter_line_perp Y P A D' P Q *)
reflexivity.
(* Goal: not (@eq F (Py D' P Q) F0) *)
(* Goal: on_inter_line_perp Y P A D' P Q *)
unfold not;intro.
(* Goal: False *)
(* Goal: on_inter_line_perp Y P A D' P Q *)
assert (parallel Y P D' P).
(* Goal: False *)
decompose [and] H;clear H.
(* Goal: Col A P Y *)
(* Goal: False *)
apply (perp_perp_para Y P P Q D' P); auto with Geom.
(* Goal: False *)
(* Goal: on_inter_line_perp Y P A D' P Q *)
assert (Col Y P D').
(* Goal: Col Y P D' *)
(* Goal: False *)
(* Goal: on_inter_line_perp Y P A D' P Q *)
unfold parallel,S4 in H11.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: False *)
(* Goal: on_inter_line_perp Y P A D' P Q *)
assert (Col Y A P).
apply (col_trans_1 Y D' A P);
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: False *)
intuition.

(* Goal: on_inter_line_perp Y P A D' P Q *)
unfold on_inter_line_perp.
(* Goal: and (Col Y A D') (and (perp Y P P Q) (not (perp P Q A D'))) *)
decompose [and] H.
(* Goal: and (not (@eq F (Py U V U) F0)) (not (@eq F (Fplus (Fplus (Fplus (Fmult (Fmult (Py P U V) (Py P U V)) (Py V C V)) (Fmult (Fmult (Py P U V) (Py P V U)) (Py V C U))) (Fmult (Fmult (Py P U V) (Py P V U)) (Py U C V))) (Fmult (Fmult (Py P V U) (Py P V U)) (Py U C U))) F0)) *)
repeat split.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.

(* Goal: forall _ : @eq F (DSeg A Y) (DSeg C D), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
intro.
(* Goal: False *)
assert (parallel A D' Y P).
(* Goal: Col A P Y *)
(* Goal: False *)
apply (perp_perp_para A D' P Q Y P);auto with Geom.
(* Goal: False *)
assert (Col A P Y).
(* Goal: Col A P Y *)
(* Goal: False *)
assert (Col P A D').
(* Goal: Col A P Y *)
(* Goal: False *)
apply (par_col_col_3 Y P A D');auto with Geom.

(* Goal: Col A P Y *)
(* Goal: False *)
assert (parallel Y P A P).
apply (col_par_par Y P A D' P);
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: Col A P Y *)
(* Goal: False *)
unfold parallel, S4 in H17.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.

(* Goal: False *)
intuition.
Qed.

Theorem elim_ratio_on_perp_d_b_invariant :
 forall Y P Q A C D : Point, forall r: F,
 on_perp_d Y P Q r ->
 ~ Col A P Y ->
 parallel A Y C D ->
 C<>D ->
 Py4 C P D Q <> 0.
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
unfold on_perp_d in H.
(* Goal: not (@eq F (Py4 C P D Q) F0) *)
use H.
(* Goal: forall _ : @eq F (DSeg A Y) (DSeg C D), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
intro.
(* Goal: Col A P Y *)
(* Goal: False *)
assert (perp C D P Q) by auto with Geom.
(* Goal: False *)
clear H.
assert (parallel Y P C D)
 by (eapply perp_perp_para;eauto).
assert (parallel Y P A Y)
 by (apply (parallel_transitivity Y P C D A Y); auto with Geom).
(* Goal: False *)
assert (Col A P Y).
(* Goal: Col A P Y *)
(* Goal: False *)
unfold parallel in *.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: Col A P Y *)
(* Goal: False *)
auto with Geom.
(* Goal: False *)
intuition.
Qed.


Theorem elim_ratio_on_perp_d_b :
 forall Y P Q A C D : Point, forall r: F,
 on_perp_d Y P Q r->
 ~ Col A P Y  ->
 parallel A Y C D ->
 C<>D ->
 A**Y / C**D = Py A P Q / Py4 C P D Q.
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
elim (classic (A**Y=C**D)).
(* Goal: forall _ : @eq F (DSeg A Y) (DSeg C D), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
intro.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
assert (on_parallel_d Y A C D 1).
(* Goal: Col A P Y *)
(* Goal: False *)
unfold on_parallel_d;repeat split;auto with Geom.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
ring_simplify;auto.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
rewrite H3.
(* Goal: @eq F (Fdiv (DSeg C D) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
replace (C ** D / C ** D) with 1 by (field;auto with Geom).
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
assert (T:=elim_ratio_on_perp_d_b_auxi A Y C D P Q H4).
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
assert (Py A P Q = Py4 C P D Q).
(* Goal: @eq F (Fdiv (Py A P Q) (Py4 C P Y Q)) (Fdiv (Py A P Q) (Py C P Q)) *)
unfold Py4.
(* Goal: @eq F (Py A P Q) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
assert (Py Y P Q = 0).
unfold on_perp_d in H;use H; unfold perp, Py4 in *.
(* Goal: @eq F (Py Y P Q) F0 *)
(* Goal: @eq F (Py A P Q) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
basic_simpl;assumption.
(* Goal: @eq F (Py A P Q) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
rewrite H5 in T.
(* Goal: @eq F (Py A P Q) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring_simplify in T.
(* Goal: @eq F (Py A P Q) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
rewrite <- T.
(* Goal: @eq F (Fminus (Py C P Q) (Py D P Q)) (Fminus (Py C P Q) (Py D P Q)) *)
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
ring.
(* Goal: @eq F F1 (Fdiv (Py A P Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
rewrite H5.
(* Goal: @eq F F1 (Fdiv (Py4 C P D Q) (Py4 C P D Q)) *)
(* Goal: forall _ : not (@eq F (DSeg A Y) (DSeg C D)), @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Py A P Q) (Py4 C P D Q)) *)
field.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
eapply elim_ratio_on_perp_d_b_invariant;eauto.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: not (@eq Point C D) *)
(* Goal: parallel Y P C D *)
(* Goal: @eq F (Fopp (Fdiv (DSeg Y P) (DSeg C D))) (Fdiv (DSeg P Y) (DSeg C D)) *)
(* Goal: @eq F (S Q P Y) (Fminus F0 (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) *)
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C D)) (Fdiv (Fminus (S A P Q) (Fmult (Fdiv r (Fplus (Fplus F1 F1) (Fplus F1 F1))) (Py P Q P))) (S4 C P D Q)) *)
eapply elim_ratio_on_perp_d_b_aux;eauto.
Qed.




Theorem elim_ratio_on_perp_d_spec_b :
 forall Y P Q A C : Point, forall r: F,
 on_perp_d Y P Q r->
 ~ Col A P Y  ->
 parallel A Y C Y ->
 C<>Y ->
 A**Y / C**Y = Py A P Q / Py C P Q.
Proof.
(* Goal: forall (Y P Q A C : Point) (r : F) (_ : on_perp_d Y P Q r) (_ : not (Col A P Y)) (_ : parallel A Y C Y) (_ : not (@eq Point C Y)), @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
intros.
(* Goal: @eq F (Fdiv (DSeg A Y) (DSeg C Y)) (Fdiv (Py A P Q) (Py C P Q)) *)
rewrite (elim_ratio_on_perp_d_b Y P Q A C Y r) by assumption.
(* Goal: @eq F (Fdiv (Py A P Q) (Py4 C P Y Q)) (Fdiv (Py A P Q) (Py C P Q)) *)
unfold Py4.
(* Goal: Col A P Y *)
(* Goal: False *)
replace (Py Y P Q) with (Py Q P Y) by auto with Geom.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Py Q P Y))) (Fdiv (Py A P Q) (Py C P Q)) *)
rewrite (elim_py_on_perp_d_right Q P P Q Y r) by assumption.
(* Goal: @eq F (Fdiv (Py A P Q) (Fminus (Py C P Q) (Fminus (Py Q P P) (Fmult (Fmult (Fplus (Fplus F1 F1) (Fplus F1 F1)) r) (S4 P Q Q P))))) (Fdiv (Py A P Q) (Py C P Q)) *)
basic_simpl.
(* Goal: @eq F (Fdiv (Py A P Q) (Py C P Q)) (Fdiv (Py A P Q) (Py C P Q)) *)
trivial.
Qed.








