(***********************************************************************)
(* (c) Copyright Microsoft Corporation and Inria. All rights reserved. *)
(*                                                                     *)
(***********************************************************************)
(***********************************************************************)
(*                                                                     *)
(*  Partial, semidirect, central and direct products.                  *)
(*                                                                     *)
(***********************************************************************)
(***********************************************************************)
Require Import ssreflect ssrbool ssrfun eqtype ssrnat seq ssralg.
Require Import bigops fintype finset groups morphisms normal.
Require Import group_perm automorphism.

Set Implicit Arguments.
Unset Strict Implicit.
Import Prenex Implicits.

Import GroupScope.

Section Defs.

Variables gT : finGroupType.
Implicit Types A B C : {set gT}.

Definition partial_product A B :=
  if A == 1 then B else if B == 1 then A else
  if [&& group_set A, group_set B & B \subset 'N(A)] then A * B else set0.

Definition semidirect_product A B :=
  if A :&: B \subset 1%G then partial_product A B else set0.

Definition central_product A B :=
  if A \subset 'C(B) then partial_product A B else set0.

Definition direct_product A B :=
  if A :&: B \subset 1%G then central_product A B else set0.

Definition complements_to_in A B :=
  [set K : {group gT} | (A :&: K == 1) && (A * K == B)].

Definition splits_over B A := complements_to_in A B != set0.

(* Product remainder functions *)

(* Deferring the left variant, as we don't need it for the moment
Definition remgl A B x := repr (A :&: x *: B).
Definition divgl A B x := (remgl A B x)^-1 * x.
*)
Definition remgr A B x := repr (A :* x :&: B).
Definition divgr A B x := x * (remgr A B x)^-1.

End Defs.

Implicit Arguments partial_product [].
Implicit Arguments semidirect_product [].
Implicit Arguments central_product [].
Implicit Arguments direct_product [].
Notation pprod := (partial_product _).
Notation sdprod := (semidirect_product _).
Notation cprod := (central_product _).
Notation dprod := (direct_product _).

Notation "G ><| H" := (sdprod G H) (at level 40, left associativity).
Notation "G \* H" := (cprod G H) (at level 40, left associativity).
Notation "G \x H" := (dprod G H) (at level 40, left associativity).

Notation "[ 'complements' 'to' A 'in' B ]" := (complements_to_in A B)
  (at level 0, format "[ 'complements'  'to'  A  'in'  B ]") : group_scope.

Notation "[ 'splits' B , 'over' A ]" := (splits_over B A)
  (at level 0, format "[ 'splits'  B ,  'over'  A ]") : group_scope.

(* Prenex Implicits remgl divgl. *)
Prenex Implicits remgr divgr.

Section InternalDirProd.

Variables gT : finGroupType.
Implicit Types A B C : {set gT}.
Implicit Types G H K : {group gT}.

Notation Local pprod := (partial_product gT).
Notation Local sdprod := (semidirect_product gT) (only parsing).
Notation Local cprod := (central_product gT) (only parsing).
Notation Local dprod := (direct_product gT) (only parsing).

Lemma pprod1g : left_unit 1 pprod.
Proof. by move=> A; rewrite /pprod eqxx. Qed.

Lemma pprodg1 : right_unit 1 pprod.
Proof. by move=> A; rewrite /pprod eqxx; case: eqP. Qed.

CoInductive are_groups A B : Prop := AreGroups G H of A = G & B = H.

Lemma group_not0 : forall G, set0 <> G.
Proof. by move=> G G0; have:= group1 G; rewrite -G0 inE. Qed.

Lemma pprodP : forall A B G,
  pprod A B = G -> [/\ are_groups A B, A * B = G & B \subset 'N(A)].
Proof.
rewrite /pprod => A B G; have Gnot0 := @group_not0 G; pose g1 := [1 gT]%G.
do 2?case: eqP => [-> ->| _].
- by rewrite mul1g norms1; split; first exists g1 G.
- by rewrite mulg1 sub1G; split; first exists G g1.
by case: and3P => // [[gA gB nBA]]; split; first exists (Group gA) (Group gB).
Qed.

Lemma pprodE : forall G H, H \subset 'N(G) -> pprod G H = G * H.
Proof.
move=> G H nGH; rewrite /pprod nGH !groupP /=.
by do 2?case: eqP => [-> | _]; rewrite ?mulg1 ?mul1g.
Qed.

Lemma pprodEgen : forall G H, H \subset 'N(G) -> pprod G H = G <*> H.
Proof. by move=> G H nGH; rewrite pprodE ?norm_mulgenEr. Qed.

Lemma mulg0 : right_zero (@set0 gT) mulg.
Proof.
by move=> A; apply/setP=> x; rewrite inE; apply/imset2P=> [[y z]]; rewrite inE.
Qed.

Lemma mul0g : left_zero (@set0 gT) mulg.
Proof.
by move=> A; apply/setP=> x; rewrite inE; apply/imset2P=> [[y z]]; rewrite inE.
Qed.

(* Properties of the remainders *)
(* Outcommented left variant as not currently used -- GG
Lemma remgl_id : forall A G x y, y \in G -> remgl A G (x * y) = remgl A G x.
Proof. by move=> A G x y Gy; rewrite {1}/remgl lcosetM lcoset_id. Qed.

Lemma remglP : forall A G x, (remgl A G x \in A :&: x *: G) = (x \in A * G).
Proof.
move=> A G x; set y := remgl A G x; apply/idP/mulsgP=> [|[a g Aa Gg x_ag]].
  rewrite inE lcoset_sym mem_lcoset; case/andP=> Ay Gy'x.
  by exists y (y^-1 * x); rewrite ?mulKVg.
by apply: (mem_repr a); rewrite inE Aa lcoset_sym mem_lcoset x_ag mulKg.
Qed.

Lemma divgl_eq : forall A B x, x = remgl A B x * divgl A B x.
Proof. by move=> A B x; rewrite mulKVg. Qed.

Lemma divgl_id : forall A G x y,
  y \in G -> divgl A G (x * y) = divgl A G x * y.
Proof. by move=> A G x y Gy; rewrite /divgl remgl_id ?mulgA. Qed.

Lemma mem_remgl : forall A G x, x \in A * G -> remgl A G x \in A.
Proof. by move=> A G x; rewrite -remglP; case/setIP. Qed.

Lemma mem_divgl : forall A G x, x \in A * G -> divgl A G x \in G.
Proof.
by move=> A G x; rewrite -remglP inE lcoset_sym mem_lcoset; case/andP.
Qed.
*)

Lemma remgrMl : forall H B x y, y \in H -> remgr H B (y * x) = remgr H B x.
Proof. by move=> H B x y Hy; rewrite {1}/remgr rcosetM rcoset_id. Qed.

Lemma remgrP : forall H B x, (remgr H B x \in H :* x :&: B) = (x \in H * B).
Proof.
move=> H B x; set y := _ x; apply/idP/mulsgP=> [|[g b Hg Bb x_gb]].
  rewrite inE rcoset_sym mem_rcoset; case/andP=> Hxy' By.
  by exists (x * y^-1) y; rewrite ?mulgKV.
by apply: (mem_repr b); rewrite inE rcoset_sym mem_rcoset x_gb mulgK Hg.
Qed.

Lemma remgr1 : forall H K x, x \in H -> remgr H K x = 1.
Proof. by move=> H K x Hx; rewrite /remgr rcoset_id ?repr_group. Qed.

Lemma divgr_eq : forall A B x, x = divgr A B x * remgr A B x.
Proof. by move=> *; rewrite mulgKV. Qed.

Lemma divgrMl : forall H B x y,
  x \in H -> divgr H B (x * y) = x * divgr H B y.
Proof. by move=> H B x y Hx; rewrite /divgr remgrMl ?mulgA. Qed.

Lemma divgr_id : forall H K x, x \in H -> divgr H K x = x.
Proof. by move=> H K x Hx; rewrite /divgr remgr1 // invg1 mulg1. Qed.

Lemma mem_remgr : forall H B x, x \in H * B -> remgr H B x \in B.
Proof. by move=> H B x; rewrite -remgrP; case/setIP. Qed.

Lemma mem_divgr : forall H B x, x \in H * B -> divgr H B x \in H.
Proof.
by move=> H B x; rewrite -remgrP inE rcoset_sym mem_rcoset; case/andP.
Qed.

Section DisjointRem.

Variables H K : {group gT}.

Hypothesis trHK : H :&: K = 1.

Lemma remgr_id : forall x, x \in K -> remgr H K x = x.
Proof.
move=> x Kx; apply/eqP; rewrite eq_mulgV1 -in_set1 -[[set 1]]trHK inE.
rewrite -mem_rcoset groupMr ?groupV // -in_setI remgrP.
by apply: subsetP Kx; exact: mulG_subr.
Qed.

Lemma remgrMid : forall x y, x \in H -> y \in K -> remgr H K (x * y) = y.
Proof. by move=> x y Hx Ky; rewrite remgrMl ?remgr_id. Qed.

Lemma divgrMid : forall x y, x \in H -> y \in K -> divgr H K (x * y) = x.
Proof. by move=> x y Hx Ky; rewrite /divgr remgrMid ?mulgK. Qed.

End DisjointRem.

(* Complements, and splitting. *)

Lemma complP : forall K A B,
  reflect (A :&: K = 1 /\ A * K = B) (K \in [complements to A in B]).
Proof. by move=> K A B; apply: (iffP setIdP); case; split; apply/eqP. Qed.

Lemma splitsP : forall B A,
  reflect (exists K, K \in [complements to A in B]) [splits B, over A].
Proof. by move=> B A; exact: set0Pn. Qed.

Lemma complgC : forall H K G,
  (H \in [complements to K in G]) = (K \in [complements to H in G]).
Proof.
move=> H K G; rewrite !inE setIC; congr (_ && _).
by apply/eqP/eqP=> defG; rewrite -(comm_group_setP _) // defG groupP.
Qed.

Section NormalComplement.

Variables H K G : {group gT}.

Hypothesis kH_K : K \in [complements to H in G].
Hypothesis nHG : H <| G.

Lemma remgrM : {in G &, {morph remgr H K : x y / x * y}}.
Proof.
case/normalP: nHG => _; case/complP: kH_K => trHK <- nHHK x y HKx HKy.
rewrite {1}(divgr_eq H K y) mulgA (conjgCV x) {2}(divgr_eq H K x) -2!mulgA.
rewrite mulgA remgrMl; last by rewrite groupMl -?mem_conjg ?nHHK ?mem_divgr.
by rewrite remgr_id // groupMl ?mem_remgr.
Qed.

End NormalComplement.

(* Semi-direct product *)

Lemma sdprod1g : left_unit 1 sdprod.
Proof. by move=> A; rewrite /sdprod subsetIl pprod1g. Qed.

Lemma sdprodg1 : right_unit 1 sdprod.
Proof. by move=> A; rewrite /sdprod subsetIr pprodg1. Qed.

Lemma sdprodP : forall A B G,
  A ><| B = G -> [/\ are_groups A B, A * B = G, B \subset 'N(A) & A :&: B = 1].
Proof.
rewrite /sdprod => A B G; case: ifP => [trAB|_]; last by case/group_not0.
case/pprodP=> gAB defG nBA; split=> {defG nBA}//.
by case: gAB trAB => H K -> ->; move/trivgP.
Qed.

Lemma sdprodE : forall G H, H \subset 'N(G) -> G :&: H = 1 -> G ><| H = G * H.
Proof. by move=> G H nGH trGH; rewrite /sdprod trGH subxx pprodE. Qed.

Lemma sdprodEgen : forall G H,
  H \subset 'N(G) -> G :&: H = 1 -> G ><| H = G <*> H.
Proof. by move=> G H nGH trGH; rewrite sdprodE ?norm_mulgenEr. Qed.

Lemma sdprod_normal_compl : forall G H K,
  H ><| K = G <-> H <| G /\ H \in [complements to K in G].
Proof.
move=> G H K; rewrite complgC; split=> [|[]].
  case/sdprodP=> _ <- nHK trHK.
  by rewrite /normal mulG_subl mul_subG ?normG // inE trHK !eqxx.
case/andP=> _ nHG; case/complP=> trHK eHK.
by rewrite sdprodE // (subset_trans _ nHG) // -eHK mulG_subr.
Qed.

Lemma sdprod_card : forall G A B, A ><| B = G -> (#|A| * #|B|)%N = #|G|.
Proof. by move=> G A B; case/sdprodP=> [[H K -> ->] <- _]; move/TI_cardMg. Qed.

(* Central product *)

Lemma cprod1g : left_unit 1 cprod.
Proof. by move=> A; rewrite /cprod sub1G pprod1g. Qed.

Lemma cprodg1 : right_unit 1 cprod.
Proof. by move=> A; rewrite /cprod cents1 pprodg1. Qed.

Lemma cprodP : forall A B G,
  A \* B = G -> [/\ are_groups A B, A * B = G & A \subset 'C(B)].
Proof.
rewrite /cprod => A B G; case: ifP => [cAB|_]; last by case/group_not0.
by case/pprodP.
Qed.

Lemma cprodE : forall G H, G \subset 'C(H) -> G \* H = G * H.
Proof. by move=> G H cGH; rewrite /cprod cGH pprodE ?cents_norm // centsC. Qed.

Lemma cprodEgen : forall G H, G \subset 'C(H) -> G \* H = G <*> H.
Proof. by move=> G H cGH; rewrite cprodE ?cent_mulgenEl. Qed.

Lemma bigcprodE : forall I (r : seq I) P F G,
  \big[cprod/1]_(i <- r | P i) F i = G
  -> \prod_(i <- r | P i) F i = G.
Proof.
move=> I r P F; pose R A B := forall G, A = G -> B = G.
apply: (big_rel R) => [|A1 B1 A2 B2 RA RB G | _ _ _] //.
by case/cprodP=> [[G1 G2 dG1 dG2] <- _]; rewrite dG1 dG2 (RA G1) ?(RB G2).
Qed.

Lemma bigcprodEgen : forall I (r : seq I) P F G,
  \big[cprod/1]_(i <- r | P i) F i = G
  -> << \bigcup_(i <- r | P i) F i >> = G.
Proof.
move=> I r P F; pose R A B := forall G, A = G -> <<B>> = G.
apply: (big_rel R) => [_ <-|A1 B1 A2 B2| i _ G ->]; rewrite ?gen0 ?genGid //.
move=> RA RB G; case/cprodP=> [[G1 G2 dG1 dG2] <-]; rewrite dG1 dG2.
by move/cent_mulgenEl <-; rewrite -(RA G1) // -(RB G2) ?mulgen_idl ?mulgen_idr.
Qed.

Lemma cprodC : commutative cprod.
Proof.
rewrite /cprod => A B; case: ifP => cAB; rewrite centsC cAB // /pprod.
by rewrite andbCA normC !cents_norm // 1?centsC //; do 2!case: eqP => // ->.
Qed.

Lemma triv_cprod : forall A B, (A \* B == 1) = (A == 1) && (B == 1).
Proof.
move=> A B; case A1: (A == 1); first by rewrite (eqP A1) cprod1g.
apply/eqP; case/cprodP=> [[G H defA ->]]; move/eqP.
by  rewrite defA trivMg -defA A1.
Qed.

Lemma cprod_ntriv : forall A B, A != 1 -> B != 1 ->
  A \* B =
    if [&& group_set A, group_set B & A \subset 'C(B)] then A * B else set0.
Proof.
move=> A B A1 B1; rewrite /cprod; case: ifP => cAB; rewrite cAB ?andbF //=.
by rewrite /pprod -if_neg A1 -if_neg B1 cents_norm // centsC.
Qed.

Lemma trivg0 : (@set0 gT == 1) = false.
Proof. by rewrite eqEcard cards0 cards1 andbF. Qed.

Lemma group0 : group_set (@set0 gT) = false.
Proof. by rewrite /group_set inE. Qed.

Lemma cprod0g : forall A, set0 \* A = set0.
Proof. by move=> A; rewrite /cprod sub0set /pprod group0 trivg0 !if_same. Qed.

Lemma cprodA : associative cprod.
Proof.
move=> A B C; case A1: (A == 1); first by rewrite (eqP A1) !cprod1g.
case B1: (B == 1); first by rewrite (eqP B1) cprod1g cprodg1.
case C1: (C == 1); first by rewrite (eqP C1) !cprodg1.
rewrite !(triv_cprod, cprod_ntriv) ?{}A1 ?{}B1 ?{}C1 //.
case: isgroupP => [[G ->{A}] | _]; last by rewrite group0.
case: (isgroupP B) => [[H ->{B}] | _]; last by rewrite group0.
case: (isgroupP C) => [[K ->{C}] | _]; last by rewrite group0 !andbF.
case cGH: (G \subset 'C(H)); case cHK: (H \subset 'C(K)); last first.
- by rewrite group0.
- by rewrite group0 /= centM subsetI cGH andbF.
- by rewrite group0 /= -gen_subG genM_mulgen mulgen_subG cHK !andbF.
rewrite /= mulgA centM subsetI cGH -(cent_mulgenEl cHK).
by rewrite -{2 3}(cent_mulgenEl cGH) mulgen_subG cHK !groupP !andbT.
Qed.

Canonical Structure cprod_law := Monoid.Law cprodA cprod1g cprodg1.
Canonical Structure cprod_abelaw := Monoid.AbelianLaw cprodC.

Lemma dprod1g : left_unit 1 dprod.
Proof. by move=> A; rewrite /dprod subsetIl cprod1g. Qed.

Lemma dprodg1 : right_unit 1 dprod.
Proof. by move=> A; rewrite /dprod subsetIr cprodg1. Qed.

Lemma dprodP : forall A B G,
  A \x B = G -> [/\ are_groups A B, A * B = G, A \subset 'C(B) & A :&: B = 1].
Proof.
rewrite /dprod=> A B G; case: ifP => trAB; last by case/group_not0.
by case/cprodP=> gAB; split=> //; case: gAB trAB => ? ? -> ->; move/trivgP.
Qed.

Lemma dprodE : forall G H,
  G \subset 'C(H) -> G :&: H = 1 -> G \x H = G * H.
Proof. by move=> G H cGH trGH; rewrite /dprod trGH sub1G cprodE. Qed.

Lemma dprodEcprod : forall A B, A :&: B = 1 -> A \x B = A \* B.
Proof. by move=> A B trAB; rewrite /dprod trAB subxx. Qed.

Lemma dprodEsdprod : forall A B, A \subset 'C(B) -> A \x B = A ><| B.
Proof. by rewrite /dprod /cprod => A B ->. Qed.

Lemma dprodEgen : forall G H,
  G \subset 'C(H) -> G :&: H = 1 -> G \x H = G <*> H.
Proof. by move=> G H cGH trGH; rewrite /dprod trGH subxx cprodEgen. Qed.

Lemma bigdprodEcprod : forall I (r : seq I) P F G,
  \big[dprod/1]_(i <- r | P i) F i = G
   -> \big[cprod/1]_(i <- r | P i) F i = G.
Proof.
move=> I r P F; rewrite -!(big_filter r).
elim: {r}filter => [|i r IHr] G; rewrite !(big_seq0, big_adds) //=.
case/dprodP=> [[F' G' -> defG'] <-]; rewrite defG' (IHr _ defG') => cFG' _.
by rewrite cprodE.
Qed.

Lemma bigdprodE : forall I (r : seq I) P F G,
  \big[dprod/1]_(i <- r | P i) F i = G
  -> \prod_(i <- r | P i) F i = G.
Proof. move=> I r P F G; move/bigdprodEcprod; exact: bigcprodE. Qed.

Lemma bigdprodEgen : forall I (r : seq I) P F G,
  \big[dprod/1]_(i <- r | P i) F i = G
  -> << \bigcup_(i <- r | P i) F i >> = G.
Proof. move=> I r P F G; move/bigdprodEcprod; exact: bigcprodEgen. Qed.

Lemma dprodC : commutative dprod.
Proof. by move=> A B; rewrite /dprod setIC cprodC. Qed.

Lemma dprodA : associative dprod.
Proof.
move=> A B C; case A1: (A == 1); first by rewrite (eqP A1) !dprod1g.
case B1: (B == 1); first by rewrite (eqP B1) dprod1g dprodg1.
case C1: (C == 1); first by rewrite (eqP C1) !dprodg1.
rewrite /dprod (fun_if (cprod A)) (fun_if (cprod^~ C)) -cprodA.
rewrite -(cprodC set0) !cprod0g cprod_ntriv ?B1 ?{}C1 //.
case: and3P B1 => [[] | _ _]; last by rewrite cprodC cprod0g !if_same.
case/isgroupP=> H ->; case/isgroupP=> K -> {B C}; move/cent_mulgenEl=> eHK H1.
rewrite cprod_ntriv ?trivMg ?{}A1 ?{}H1 // centM subsetI.
case: and4P => [[] | _]; last by rewrite !if_same.
case/isgroupP=> G ->{A} _ cGH _; rewrite cprodEgen // -eHK.
case trGH: (G :&: H \subset _); case trHK: (H :&: K \subset _); last first.
- by rewrite !if_same.
- rewrite if_same; case: ifP => // trG_HK; case/negP: trGH.
  by apply: subset_trans trG_HK; rewrite setIS ?mulgen_subl.
- rewrite if_same; case: ifP => // trGH_K; case/negP: trHK.
  by apply: subset_trans trGH_K; rewrite setSI ?mulgen_subr.
do 2![case: ifP] => // trGH_K trG_HK; [case/negP: trGH_K | case/negP: trG_HK].
  apply: subset_trans trHK; rewrite subsetI subsetIr -{2}(mulg1 H) -mulGS.
  rewrite setIC group_modl ?mulgen_subr //= cent_mulgenEl // -eHK.
  by rewrite -group_modr ?mulgen_subl //= setIC -(normC (sub1G _)) mulSg.
apply: subset_trans trGH; rewrite subsetI subsetIl -{2}(mul1g H) -mulSG.
rewrite setIC group_modr ?mulgen_subl //= eHK -(cent_mulgenEl cGH).
by rewrite -group_modl ?mulgen_subr //= setIC (normC (sub1G _)) mulgS.
Qed.

Canonical Structure dprod_law := Monoid.Law dprodA dprod1g dprodg1.
Canonical Structure dprod_abelaw := Monoid.AbelianLaw dprodC.

End InternalDirProd.

Implicit Arguments complP [gT K A B].
Implicit Arguments splitsP [gT A B].

Section ExternalDirProd.

Variables gT1 gT2 : finGroupType.

Definition extprod_mulg (x y : gT1 * gT2) := (x.1 * y.1, x.2 * y.2).
Definition extprod_invg (x : gT1 * gT2) := (x.1^-1, x.2^-1).

Lemma extprod_mul1g : left_unit (1, 1) extprod_mulg.
Proof. case=> x1 x2; congr (_, _); exact: mul1g. Qed.

Lemma extprod_mulVg : left_inverse (1, 1) extprod_invg extprod_mulg.
Proof. by move=> x; congr (_, _); exact: mulVg. Qed.

Lemma extprod_mulgA : associative extprod_mulg.
Proof. by move=> x y z; congr (_, _); exact: mulgA. Qed.

Canonical Structure extprod_baseFinGroupType := Eval hnf in
  [baseFinGroupType of gT1 * gT2
     by extprod_mulgA, extprod_mul1g & extprod_mulVg].

Canonical Structure prod_group := FinGroupType extprod_mulVg.

Lemma group_setX : forall (H1 : {group gT1}) (H2 : {group gT2}),
  group_set (setX H1 H2).
Proof.
move=> H1 H2; apply/group_setP; split; first by rewrite inE !group1.
case=> [x1 x2] [y1 y2]; rewrite !inE; case/andP=> Hx1 Hx2; case/andP=> Hy1 Hy2.
by rewrite /= !groupM.
Qed.

Canonical Structure setX_group H1 H2 := Group (group_setX H1 H2).

Definition pairg1 x : gT1 * gT2 := (x, 1).
Definition pair1g x : gT1 * gT2 := (1, x).

Lemma pairg1_morphM : {morph pairg1 : x y / x * y}.
Proof. by move=> x y /=; rewrite {2}/mulg /= /extprod_mulg /= mul1g. Qed.

Canonical Structure pairg1_morphism :=
  @Morphism _ _ setT _ (in2W pairg1_morphM).

Lemma pair1g_morphM : {morph pair1g : x y / x * y}.
Proof. by move=> x y /=; rewrite {2}/mulg /= /extprod_mulg /= mul1g. Qed.

Canonical Structure pair1g_morphism :=
  @Morphism _ _ setT _ (in2W pair1g_morphM).

Lemma injm_pair1g : 'injm pair1g.
Proof.
apply/subsetP=> x; case/morphpreP=> _; case/set1P=> ->; exact: set11.
Qed.

Lemma injm_pairg1 : 'injm pairg1.
Proof.
apply/subsetP=> x; case/morphpreP=> _; case/set1P=> ->; exact: set11.
Qed.

Lemma morphim_pairg1 : forall (H1 : {set gT1}), pairg1 @* H1 = setX H1 1.
Proof.
by move=> H1; rewrite -imset2_pair imset2_set1r morphimEsub ?subsetT.
Qed.

Lemma morphim_pair1g : forall (H2 : {set gT2}), pair1g @* H2 = setX 1 H2.
Proof.
by move=> H1; rewrite -imset2_pair imset2_set1l morphimEsub ?subsetT.
Qed.

Lemma setX_prod : forall (H1 : {set gT1}) (H2 : {set gT2}),
  setX H1 1 * setX 1 H2 = setX H1 H2.
Proof.
move=> H1 H2; apply/setP=> [[x y]]; rewrite !inE /=.
apply/imset2P/andP=> [[[x1 u1] [v1 y1]] | [Hx Hy]].
  rewrite !inE /=; case/andP=> Hx1; move/eqP->; case/andP; move/eqP=> -> Hx2.
  by case=> -> ->; rewrite mulg1 mul1g.
exists (x, 1 : gT2) (1 : gT1, y); rewrite ?inE ?Hx ?eqxx //.
by rewrite /mulg /= /extprod_mulg /= mulg1 mul1g.
Qed.

Lemma setX_dprod : forall (H1 : {group gT1}) (H2 : {group gT2}),
  setX H1 1 \x setX 1 H2 = setX H1 H2.
Proof.
move=> H1 H2; rewrite dprodE ?setX_prod //.
  apply/centsP=> [[x u]]; rewrite !inE /=; case/andP=> _; move/eqP=> -> [v y].
  rewrite !inE /=; case/andP; move/eqP=> -> _.
  by rewrite /commute /mulg /= /extprod_mulg /= !mulg1 !mul1g.
apply/trivgP; apply/subsetP=> [[x y]]; rewrite !inE /= -!andbA; case/and4P=> _.
by do 2!move/eqP->; rewrite eqxx.
Qed.

Lemma isog_setX1 : forall (H1 : {group gT1}), isog H1 (setX H1 1).
Proof.
move=> H1; apply/isogP; exists [morphism of restrm (subsetT H1) pairg1].
  by rewrite injm_restrm ?injm_pairg1.
by rewrite morphim_restrm morphim_pairg1 setIid.
Qed.

Lemma isog_set1X : forall (H2 : {group gT2}), isog H2 (setX 1 H2).
Proof.
move=> H2; apply/isogP; exists [morphism of restrm (subsetT H2) pair1g].
  by rewrite injm_restrm ?injm_pair1g.
by rewrite morphim_restrm morphim_pair1g setIid.
Qed.

Lemma setX_gen (H1 : {set gT1}) (H2 : {set gT2}):
  1 \in H1 -> 1 \in H2 -> <<setX H1 H2>> = setX <<H1>> <<H2>>.
Proof.
move=> H1 H2 H1_1 H2_1; apply/eqP.
rewrite eqEsubset gen_subG setXS ?subset_gen //.
rewrite -setX_prod -morphim_pair1g -morphim_pairg1 !morphim_gen ?subsetT //.
by rewrite morphim_pair1g morphim_pairg1 mul_subG // genS // setXS ?sub1set.
Qed.

End ExternalDirProd.

Section ExternalSDirProd.

Variables (hT kT : finGroupType) (H : {group hT}) (K : {group kT}).
Variable to : {morphism K >-> {perm hT}}.

(* Beware: the pair (x, a) denotes the product sdpair2 a * sdpair1 x *)

Inductive sdprod_of (toAut : to @* K \subset Aut H) : predArgType :=
  SdPair (xa : hT * kT) & xa \in setX H K.

Coercion pair_of_sd toAut (u : sdprod_of toAut) := let: SdPair xa _ := u in xa.

Hypothesis toAut : to @* K \subset Aut H.

Notation sdT := (sdprod_of toAut).
Notation sdval := (@pair_of_sd toAut).

Canonical Structure sdprod_subType :=
  SubType sdval (@sdprod_of_rect toAut) vrefl.
Canonical Structure sdprod_eqType := Eval hnf in [subEqType for sdval].
Canonical Structure sdprod_finType := Eval hnf in [finType of sdT by :>].
Canonical Structure sdprod_subFinType := Eval hnf in [subFinType of sdT].

Definition sdprod_unit := SdPair toAut (group1 _).

Lemma sdprod_aut_proof : forall a, a \in K -> to a \in Aut H.
Proof. by move=> a Ka; rewrite (subsetP toAut) ?mem_morphim. Qed.

Notation Local toA := sdprod_aut_proof.

Lemma sdprod_closed : forall a x, a \in K -> (to a x \in H) = (x \in H).
Proof. by move=> a x Ka; apply: perm_closed; case/setIdP: (toA Ka). Qed.

Lemma sdprod_inv_proof : forall u : sdT,
  (to u.2^-1 u.1^-1, u.2^-1) \in setX H K.
Proof.
case=> [[x a]] /=; case/setXP=> Hx Ka.
by rewrite inE sdprod_closed !groupV ?Hx ?Ka.
Qed.

Definition sdprod_inv u := SdPair toAut (sdprod_inv_proof u).

Lemma sdprod_mul_proof : forall u v : sdT,
  (to v.2 u.1 * v.1, u.2 * v.2) \in setX H K.
Proof.
case=> [[x a]] /=; case/setXP=> Hx Ka [[y b]] /=; case/setXP=> Hy Kb.
by rewrite inE !groupMr //= sdprod_closed ?Hx.
Qed.

Definition sdprod_mul u v := SdPair toAut (sdprod_mul_proof u v).

Lemma sdprod_mul1g : left_unit sdprod_unit sdprod_mul.
Proof.
move=> u; apply: val_inj; case: u => [[x a] /=]; case/setXP=> _ Ka.
by rewrite -(autmE (toA Ka)) morph1 !mul1g.
Qed.

Lemma sdprod_mulVg : left_inverse sdprod_unit sdprod_inv sdprod_mul.
Proof.
move=> u; apply: val_inj; case: u => [[x a] /=]; case/setXP=> _ Ka.
by rewrite morphV // permKV !mulVg.
Qed.

Lemma sdprod_mulgA : associative sdprod_mul.
Proof.
move=> u v w; apply: val_inj; case: u => [[x a]] /=; case/setXP=> Hx Ka.
case: v w => [[y b]] /=; case/setXP=> Hy Kb [[z c]] /=; case/setXP=> Hz Kc.
by rewrite !mulgA -(autmE (toA Kc)) !morphM ?permM ?sdprod_closed.
Qed.

Canonical Structure sdprod_baseFinGroupType := Eval hnf in
  [baseFinGroupType of sdT by sdprod_mulgA, sdprod_mul1g & sdprod_mulVg].

Canonical Structure sdprod_groupType := FinGroupType sdprod_mulVg.

Definition sdpair1 x := insubd sdprod_unit (x, 1) : sdT.
Definition sdpair2 a := insubd sdprod_unit (1, a) : sdT.

Lemma sdpair1_morphM : {in H &, {morph sdpair1 : x y / x * y}}.
Proof.
move=> x y Hx Hy; apply: val_inj.
by rewrite /= !val_insubd !inE !group1 !groupM ?Hx ?Hy //= mulg1 morph1 perm1.
Qed.

Lemma sdpair2_morphM : {in K &, {morph sdpair2 : a b / a * b}}.
Proof.
move=> a b Ka Kb; apply: val_inj.
rewrite /= !val_insubd !inE !group1 !groupM ?Ka ?Kb //= mulg1.
by rewrite -(autmE (toA Kb)) morph1.
Qed.

Canonical Structure sdpair1_morphism := Morphism sdpair1_morphM.

Canonical Structure sdpair2_morphism := Morphism sdpair2_morphM.

Lemma injm_sdpair1 : 'injm sdpair1.
Proof.
apply/subsetP=> x; case/setIP=> Hx.
by rewrite !inE -val_eqE val_insubd inE Hx group1 /=; case/andP.
Qed.

Lemma injm_sdpair2 : 'injm sdpair2.
Proof.
apply/subsetP=> a; case/setIP=> Ka.
by rewrite !inE -val_eqE val_insubd inE Ka group1 /=; case/andP.
Qed.

Lemma sdpairJ : forall x a,
  x \in H -> a \in K -> sdpair1 x ^ sdpair2 a = sdpair1 (to a x).
Proof.
move=> x a Hx Ka; apply: val_inj.
rewrite /= !val_insubd !inE !group1 sdprod_closed ?Ka ?Hx //=.
by rewrite !mul1g mulVg invg1 mulg1 morphV // permKV mul1g.
Qed.

Lemma sdpairEdom: sdpair1 @* H ><| sdpair2 @* K = setT.
Proof.
apply/eqP; rewrite -subTset sdprodE /= !morphimEdom /=.
- apply/subsetP=> /= u _; have [/= Hu Ku] := setIdP (valP u).
  apply/imset2P; exists (sdpair1 (to u.2^-1 u.1)) (sdpair2 u.2).
  + by rewrite mem_imset ?sdprod_closed ?groupV.
  + by rewrite mem_imset.
  rewrite -sdpairJ ?groupV // morphV // -conjgCV; apply: val_inj.
  rewrite /= !val_insubd !inE {}Ku {}Hu !group1 /= morph1 perm1 mulg1 mul1g.
  by case: u => [[]].
- apply/subsetP=> u; case/imsetP=> a Ka ->{u}; rewrite inE.
  apply/subsetP=> va; case/imsetP=> v; case/imsetP=> x Hx -> -> {v va}.
  by rewrite sdpairJ // mem_imset // sdprod_closed.
apply/trivgP; apply/subsetP=> u; case/setIP; case/imsetP=> a Ka ->{u}.
case/imsetP=> x Hx; move/eqP; rewrite inE -!val_eqE.
by rewrite !val_insubd !inE Ka Hx !group1 /eqd /= eqxx; case/andP=> ->.
Qed.

End ExternalSDirProd.

Section ProdMorph.

Variables gT rT : finGroupType.
Implicit Types A B : {set gT}.
Implicit Types G H K : {group gT}.
Implicit Types C D : {set rT}.
Implicit Type L : {group rT}.

Section defs.

Variables (A B : {set gT}) (fA fB : gT -> FinGroup.sort rT).

Definition morph_actJ := forall x a, fA (x ^ a) = fA x ^ fB a.

Definition pprodm of B \subset 'N(A) & {in A & B, morph_actJ}
                  & {in A :&: B, fA =1 fB} :=
  fun x => fA (divgr A B x) * fB (remgr A B x).

End defs.

Section Props.

Variables H K : {group gT}.
Variables (fH : {morphism H >-> rT}) (fK : {morphism K >-> rT}).
Hypothesis nHK : K \subset 'N(H).
Hypothesis actf : {in H & K, morph_actJ fH fK}.
Hypothesis eqfHK : {in H :&: K, fH =1 fK}.

Notation Local f := (pprodm nHK actf eqfHK).

Lemma pprodmE : forall x a, x \in H -> a \in K -> f (x * a) = fH x * fK a.
Proof.
move=> x a Hx Ka; have: x * a \in H * K by rewrite mem_imset2.
rewrite -remgrP inE /f rcoset_sym mem_rcoset /divgr -mulgA groupMl //.
case/andP; move: (remgr H K _) => b Hab Kb; rewrite morphM // -mulgA.
have Kab: a * b^-1 \in K by rewrite groupM ?groupV.
by congr (_ * _); rewrite eqfHK 1?inE ?Hab // -morphM // mulgKV.
Qed.

Lemma pprodmEl : {in H, f =1 fH}.
Proof. by move=> x Hx; rewrite -(mulg1 x) pprodmE // morph1 !mulg1. Qed.

Lemma pprodmEr : {in K, f =1 fK}.
Proof. by move=> a Ka; rewrite -(mul1g a) pprodmE // morph1 !mul1g. Qed.

Lemma pprodmM : {in H <*> K &, {morph f: x y / x * y}}.
Proof.
move=> xa yb; rewrite norm_mulgenEr //.
case/imset2P=> x a Ha Ka ->{xa}; case/imset2P=> y b Hy Kb ->{yb}.
have Hya: y ^ a^-1 \in H by rewrite -mem_conjg (normsP nHK).
rewrite mulgA -(mulgA x) (conjgCV a y) (mulgA x) -mulgA !pprodmE 1?groupMl //.
by rewrite 2?morphM // actf ?groupV ?morphV // !mulgA mulgKV invgK.
Qed.

Canonical Structure pprodm_morphism := Morphism pprodmM.

Lemma morphim_pprodm : forall A B,
  A \subset H -> B \subset K -> f @* (A * B) = fH @* A * fK @* B.
Proof.
move=> A B sAH sBK; rewrite [f @* _]morphimEsub /=; last first.
  by rewrite norm_mulgenEr // mulgSS.
apply/setP=> y; apply/imsetP/idP=> [[xa] |].
  case/imset2P=> x a Ax Ba -> -> {y xa}.
  have Hx := subsetP sAH x Ax; have Ka := subsetP sBK a Ba.
  by rewrite pprodmE // mem_imset2 ?mem_morphim.
case/imset2P=> fx fa.
case/morphimP=> x Hx Ax ->; case/morphimP=> a Ka Ba -> ->{y fx fa}.
by exists (x * a); rewrite ?mem_imset2 ?pprodmE.
Qed.

Lemma morphim_pprodml : forall A, A \subset H -> f @* A = fH @* A.
Proof.
by move=> A sAH; rewrite -{1}(mulg1 A) morphim_pprodm ?sub1G // morphim1 mulg1.
Qed.

Lemma morphim_pprodmr : forall B, B \subset K -> f @* B = fK @* B.
Proof.
by move=> B sBK; rewrite -{1}(mul1g B) morphim_pprodm ?sub1G // morphim1 mul1g.
Qed.

Lemma ker_pprodm : 'ker f = [set x * a^-1 | x <- H, a <- K, fH x == fK a].
Proof.
apply/setP=> y; rewrite 3!inE {1}norm_mulgenEr //=.
apply/andP/imset2P=> [[]|[x a Hx]].
  case/imset2P=> x a Hx Ka ->{y}; rewrite pprodmE // => fxa1.
  by exists x a^-1; rewrite ?invgK // inE groupVr ?morphV // eq_mulgV1 invgK.
case/setIdP=> Kx; move/eqP=> fx -> {y}.
by rewrite mem_imset2 ?pprodmE ?groupV ?morphV // fx mulgV.
Qed.

Lemma injm_pprodm :
  'injm f = [&& 'injm fH, 'injm fK & fH @* H :&: fK @* K == fH @* K].
Proof.
apply/idP/and3P=> [injf | [injfH injfK]].
  rewrite eq_sym -{1}morphimIdom -(morphim_pprodml (subsetIl _ _)) injmI //.
  rewrite morphim_pprodml // morphim_pprodmr //=; split=> //.
    apply/injmP=> x y Hx Hy /=; rewrite -!pprodmEl //.
    by apply: (injmP _ injf); rewrite ?mem_gen ?inE ?Hx ?Hy.
  apply/injmP=> a b Ka Kb /=; rewrite -!pprodmEr //.
  by apply: (injmP _ injf); rewrite ?mem_gen //; apply/setUP; right.
move/eqP=> fHK; rewrite ker_pprodm; apply/subsetP=> y.
case/imset2P=> x a Hx; case/setIdP=> Ka; move/eqP=> fxa ->.
have: fH x \in fH @* K by rewrite -fHK inE {2}fxa !mem_morphim.
case/morphimP=> z Hz Kz; move/(injmP _ injfH) => def_x.
rewrite def_x // eqfHK ?inE ?Hz // in fxa.
by rewrite def_x // (injmP _ injfK _ _ Kz Ka fxa) mulgV set11.
Qed.

End Props.

Section Sdprodm.

Variables H K G : {group gT}.
Variables (fH : {morphism H >-> rT}) (fK : {morphism K >-> rT}).
Hypothesis eqHK_G : H ><| K = G.
Hypothesis actf : {in H & K, morph_actJ fH fK}.

Lemma sdprodm_norm : K \subset 'N(H).
Proof. by case/sdprodP: eqHK_G. Qed.

Lemma sdprodm_sub : G \subset H <*> K.
Proof. by case/sdprodP: eqHK_G => _ <- nHK _; rewrite norm_mulgenEr. Qed.

Lemma sdprodm_eqf : {in H :&: K, fH =1 fK}.
Proof.
by case/sdprodP: eqHK_G => _ _ _ -> x; move/set1P->; rewrite !morph1.
Qed.

Definition sdprodm :=
  restrm sdprodm_sub (pprodm sdprodm_norm actf sdprodm_eqf).

Canonical Structure sdprodm_morphism := Eval hnf in [morphism of sdprodm].

Lemma sdprodmE : forall a b,
  a \in H -> b \in K -> sdprodm (a * b) = fH a * fK b.
Proof. exact: pprodmE. Qed.

Lemma sdprodmEl : forall a, a \in H -> sdprodm a = fH a.
Proof. exact: pprodmEl. Qed.

Lemma sdprodmEr : forall b, b \in K -> sdprodm b = fK b.
Proof. exact: pprodmEr. Qed.

Lemma morphim_sdprodm : forall A B,
  A \subset H -> B \subset K -> sdprodm @* (A * B) = fH @* A * fK @* B.
Proof.
move=> A B sAH sBK; rewrite morphim_restrm /= (setIidPr _) ?morphim_pprodm //.
case/sdprodP: eqHK_G => _ <- _ _; exact: mulgSS.
Qed.

Lemma morphim_sdprodml : forall A, A \subset H -> sdprodm @* A = fH @* A.
Proof.
move=> A sHA.
by rewrite -{1}(mulg1 A) morphim_sdprodm ?sub1G // morphim1 mulg1.
Qed.

Lemma morphim_sdprodmr : forall B, B \subset K -> sdprodm @* B = fK @* B.
Proof.
move=> B sBK.
by rewrite -{1}(mul1g B) morphim_sdprodm ?sub1G // morphim1 mul1g.
Qed.

Lemma ker_sdprodm :
  'ker sdprodm = [set a * b^-1 | a <- H, b <- K, fH a == fK b].
Proof.
rewrite ker_restrm (setIidPr _) ?subIset ?ker_pprodm //; apply/orP; left.
by case/sdprodP: eqHK_G => _ <- nHK _; rewrite norm_mulgenEr.
Qed.

Lemma injm_sdprodm :
  'injm sdprodm = [&& 'injm fH, 'injm fK & fH @* H :&: fK @* K == fH @* K].
Proof.
by rewrite ker_sdprodm -(ker_pprodm sdprodm_norm actf sdprodm_eqf) injm_pprodm.
Qed.

End Sdprodm.

Section Cprodm.

Variables H K G : {group gT}.
Variables (fH : {morphism H >-> rT}) (fK : {morphism K >-> rT}).
Hypothesis eqHK_G : H \* K = G.
Hypothesis cfHK : fH @* H \subset 'C(fK @* K).
Hypothesis eqfHK : {in H :&: K, fH =1 fK}.

Lemma cprodm_norm : K \subset 'N(H).
Proof. by rewrite cents_norm // centsC; case/cprodP: eqHK_G. Qed.

Lemma cprodm_sub : G \subset H <*> K.
Proof. by case/cprodP: eqHK_G => _ <- cHK; rewrite cent_mulgenEl. Qed.

Lemma cprodm_actf : {in H & K, morph_actJ fH fK}.
Proof.
case/cprodP: eqHK_G => _ _ cHK a b Ha Kb /=.
rewrite /conjg (centsP cHK a) // mulKg.
by rewrite (centsP cfHK (fH a)) ?mem_morphim // mulKg.
Qed.

Definition cprodm := restrm cprodm_sub (pprodm cprodm_norm cprodm_actf eqfHK).

Canonical Structure cprodm_morphism := Eval hnf in [morphism of cprodm].

Lemma cprodmE : forall a b, a \in H -> b \in K -> cprodm (a * b) = fH a * fK b.
Proof. exact: pprodmE. Qed.

Lemma cprodmEl : forall a, a \in H -> cprodm a = fH a.
Proof. exact: pprodmEl. Qed.

Lemma cprodmEr : forall b, b \in K -> cprodm b = fK b.
Proof. exact: pprodmEr. Qed.

Lemma morphim_cprodm : forall A B,
  A \subset H -> B \subset K -> cprodm @* (A * B) = fH @* A * fK @* B.
Proof.
move=> A B sAH sBK; rewrite morphim_restrm /= (setIidPr _) ?morphim_pprodm //.
case/cprodP: eqHK_G => _ <- _; exact: mulgSS.
Qed.

Lemma morphim_cprodml : forall A, A \subset H -> cprodm @* A = fH @* A.
Proof.
by move=> A sHA; rewrite -{1}(mulg1 A) morphim_cprodm ?sub1G // morphim1 mulg1.
Qed.

Lemma morphim_cprodmr : forall B, B \subset K -> cprodm @* B = fK @* B.
Proof.
by move=> B sBK; rewrite -{1}(mul1g B) morphim_cprodm ?sub1G // morphim1 mul1g.
Qed.

Lemma ker_cprodm : 'ker cprodm = [set a * b^-1 | a <- H, b <- K, fH a == fK b].
Proof.
rewrite ker_restrm (setIidPr _) ?subIset ?ker_pprodm //; apply/orP; left.
by case/cprodP: eqHK_G => _ <- cHK; rewrite cent_mulgenEl.
Qed.

Lemma injm_cprodm :
  'injm cprodm = [&& 'injm fH, 'injm fK & fH @* H :&: fK @* K == fH @* K].
Proof.
by rewrite ker_cprodm -(ker_pprodm cprodm_norm cprodm_actf eqfHK) injm_pprodm.
Qed.

End Cprodm.

Section Dprodm.

Variables G H K : {group gT}.
Variables (fH : {morphism H >-> rT}) (fK : {morphism K >-> rT}).
Hypothesis eqHK_G : H \x K = G.
Hypothesis cfHK : fH @* H \subset 'C(fK @* K).

Lemma dprodm_cprod : H \* K = G.
Proof.
by rewrite -eqHK_G /dprod; case/dprodP: eqHK_G => _ _ _ ->; rewrite subxx.
Qed.

Lemma dprodm_eqf : {in H :&: K, fH =1 fK}.
Proof.
by case/dprodP: eqHK_G => _ _ _ -> x; move/set1P->; rewrite !morph1.
Qed.

Definition dprodm := cprodm dprodm_cprod cfHK dprodm_eqf.

Canonical Structure dprodm_morphism := Eval hnf in [morphism of dprodm].

Lemma dprodmE : forall a b, a \in H -> b \in K -> dprodm (a * b) = fH a * fK b.
Proof. exact: pprodmE. Qed.

Lemma dprodmEl : forall a, a \in H -> dprodm a = fH a.
Proof. exact: pprodmEl. Qed.

Lemma dprodmEr : forall b, b \in K -> dprodm b = fK b.
Proof. exact: pprodmEr. Qed.

Lemma morphim_dprodm : forall A B,
  A \subset H -> B \subset K -> dprodm @* (A * B) = fH @* A * fK @* B.
Proof. exact: morphim_cprodm. Qed.

Lemma morphim_dprodml : forall A, A \subset H -> dprodm @* A = fH @* A.
Proof. exact: morphim_cprodml. Qed.

Lemma morphim_dprodmr : forall B, B \subset K -> dprodm @* B = fK @* B.
Proof. exact: morphim_cprodmr. Qed.

Lemma ker_dprodm : 'ker dprodm = [set a * b^-1 | a <- H, b <- K, fH a == fK b].
Proof. exact: ker_cprodm. Qed.

Lemma injm_dprodm :
  'injm dprodm = [&& 'injm fH, 'injm fK & fH @* H :&: fK @* K == 1].
Proof.
rewrite injm_cprodm -(morphimIdom fH K).
by case/dprodP: eqHK_G => _ _ _ ->; rewrite morphim1.
Qed.

End Dprodm.

Lemma isog_dprod : forall A B G C D L,
  A \x B = G -> C \x D = L -> isog A C -> isog B D -> isog G L.
Proof.
move=> A0 B0 G C0 D0 L defG.
case/dprodP=> [[C D -> ->] defL cCD trCD] {C0 D0}.
case/dprodP: defG (defG) => [[A B -> ->] defG _ _] dG {A0 B0} defC defD.
case/isogP: defC defL cCD trCD => fA injfA <-{C}.
case/isogP: defD => fB injfB <-{D} defL cCD trCD.
apply/isogP; exists (dprodm_morphism dG cCD).
  by rewrite injm_dprodm injfA injfB trCD eqxx.
by rewrite /= -{2}defG morphim_dprodm.
Qed.

End ProdMorph.

Section DirprodIsom.

Variable gT : finGroupType.
Implicit Types G H : {group gT}.

Definition mulgm : gT * gT -> _ := prod_curry mulg.

Lemma imset_mulgm : forall A B : {set gT}, mulgm @: setX A B = A * B.
Proof. by move=> A B; rewrite -curry_imset2X. Qed.

Lemma mulgmP : forall H1 H2 G,
  reflect (H1 \x H2 = G) (misom (setX H1 H2) G mulgm).
Proof.
move=> H1 H2 G; apply: (iffP misomP) => [[pM] | ].
  case/isomP=> injf /= <-; case/dprodP: (setX_dprod H1 H2) => _ /= defX cH12.
  rewrite -{4}defX {}defX; move/(congr1 (fun A => morphm pM @* A)).
  move/(morphimS (morphm_morphism pM)): cH12 => /=.
  have sH1H: setX H1 1 \subset setX H1 H2 by rewrite setXS ?sub1G.
  have sH2H: setX 1 H2 \subset setX H1 H2 by rewrite setXS ?sub1G.
  rewrite morphim1 injm_cent ?injmI //= subsetI; case/andP=> _.
  by rewrite !morphimEsub //= !imset_mulgm mulg1 mul1g; exact: dprodE.
case/dprodP=> _ defG cH12 trH12.
have fM: morphic (setX H1 H2) mulgm.
  apply/morphicP=> [[x1 x2] [y1 y2]]; rewrite !inE /=.
  case/andP=> _ Hx2; case/andP=> Hy1 _.
  by rewrite /= mulgA -(mulgA x1) (centsP cH12 y1) ?mulgA.
exists fM; apply/isomP; split; last by rewrite morphimEsub //= imset_mulgm.
apply/subsetP=> [[x1 x2]]; rewrite !inE /= andbC -eq_invg_mul.
case: eqP => //= <-; rewrite groupV -in_setI trH12; move/set1P->.
by rewrite invg1 eqxx.
Qed.

End DirprodIsom.

Implicit Arguments mulgmP [gT H1 H2 G].
Prenex Implicits mulgm mulgmP.


(* TLC in Coq
 *
 * Module: tlc.syntax.variable
 * Purpose: Contains the syntax of variables.
 *)

Require Import mathcomp.ssreflect.choice.
Require Import mathcomp.ssreflect.eqtype.
Require Import mathcomp.ssreflect.ssrbool.
Require Import mathcomp.ssreflect.ssreflect.
Require Import tlc.syntax.flexible.
Require Import tlc.syntax.rigid.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

(* Flexible or rigid variables *)
Inductive variable := VF (x : flexible) | VR (x : rigid).

(* Equality *)
Section eq.

  (* Boolean equality *)
  Definition variable_eq x1 x2 :=
    match x1, x2 with
    | VF x1, VF x2 => x1 == x2
    | VR x1, VR x2 => x1 == x2
    | _, _ => false
    end.

  (* Boolean equality reflection *)
  Lemma variable_eqP : Equality.axiom variable_eq.
  Proof.
    case=> [x1 | x1] [x2 | x2] //=; try by constructor.
    - by have [<- | neqx] := x1 =P x2; last (by right; case); constructor.
    - by have [<- | neqx] := x1 =P x2; last (by right; case); constructor.
  Qed.

  (* EqType canonical structures *)
  Definition variable_eqMixin := EqMixin variable_eqP.
  Canonical variable_eqType := EqType variable variable_eqMixin.

End eq.

(* Constructor coercions *)
Coercion VF : flexible >-> variable.
Coercion VR : rigid >-> variable.


Require Import A1_Plan A2_Orientation A5_Cercle A7_Tactics .
Require Import B7_Tactics .
Require Import C1_Distance C5_TriangularInequality C7_Tactics .
Require Import D1_IntersectionCirclesProp D5_Tactics .
Require Import F2_MarkSegment F5_Tactics .
Require Import G1_Angles G3_ParticularAngle G4_Tactics .
Require Import H1_Triangles H4_Tactics .
Require Import I1_SupplementaryAngle.

Section SUPPLEMENT.

Ltac destructAngle A B C Hba Hbc M :=
unfold Angle at 1 in |- *; simpl in |- *;
unfold IntersectionCirclesPoint in |- *;
let H1 := fresh in let H2 := fresh in let H3 := fresh in let H4 := fresh in
(destruct (InterCirclesPointDef uCircle (Compass Uu (MarkSegmentPoint B A Oo Uu Hba) (MarkSegmentPoint B C Oo Uu Hbc))) as (M, ((H1, (H2, H3)), H4));
simpl in H1, H2, H3, H4).

Inductive  Supplement  (A B C D E F : Point)  : Prop :=
	| EqAngleSupplement : forall (Hba : B <> A) (Hbc : B <> C) (Hed : E <> D) (Hef : E <> F),
		Angle A B C Hba Hbc = Supplementary (Angle D E F Hed Hef)  (IsAngleAngle D E F Hed Hef) ->
		Supplement A B C D E F.

Lemma SupplementRev1 : forall A B C D E F : Point,
	Supplement A B C D E F ->
	Supplement C B A D E F.
Proof.
	intros.
	inversion H.
	apply (EqAngleSupplement C B A D E F Hbc Hba Hed Hef).
	rewrite <- H0.
	immediate7.
Qed.

Lemma SupplementSym : forall A B C D E F : Point,
	Supplement A B C D E F ->
	Supplement  D E F A B C.
Proof.
	intros.
	inversion H.
	apply (EqAngleSupplement D E F A B C Hed Hef Hba Hbc).
	apply  (SupplementarySym (Angle D E F Hed Hef) (Angle A B C Hba Hbc)  (IsAngleAngle D E F Hed Hef) (IsAngleAngle A B C Hba Hbc) H0).
Qed.

Lemma SupplementRev2 : forall A B C D E F : Point,
	Supplement A B C D E F ->
	Supplement A B C F E D.
Proof.
	intros.
	apply SupplementSym; apply SupplementRev1; apply SupplementSym; exact H.
Qed.

Lemma SupplementSupplementary : forall A B C D E F : Point, forall (Hba : B <> A) (Hbc : B <> C) (Hed : E <> D) (Hef : E <> F),
	Supplement A B C D E F ->
	Angle A B C Hba Hbc = Supplementary (Angle D E F Hed Hef) (IsAngleAngle D E F Hed Hef).
Proof.
	intros.
	inversion H.
	since7 (Angle A B C Hba Hbc = Angle A B C Hba0 Hbc0).
	 rewrite H1.
	   rewrite H0.
	   apply SupplementaryEqAngles.
	   immediate7.
Qed.

Lemma SupplementCongruentSupplement : forall A B C D E F K L M : Point,
	Supplement A B C K L M ->
	CongruentAngle A B C D E F ->
	Supplement D E F K L M.
Proof.
	intros.
	inversion H.
	inversion H0.
	apply (EqAngleSupplement D E F K L M Hed0 Hef0 Hed Hef).
	rewrite <- H1; rewrite <- H2.
	immediate7.
Qed.

Lemma SupplementSupplementCongruent : forall A B C D E F K L M : Point,
	Supplement A B C K L M ->
	Supplement D E F K L M ->
	CongruentAngle A B C D E F.
Proof.
	intros.
	inversion H.
	inversion H0.
	apply (CongruentEqAngle A B C D E F Hba Hbc Hba0 Hbc0).
	rewrite H1; rewrite H2.
	apply SupplementaryEqAngles; immediate7.
Qed.

Lemma BetweenSupplementAngles : forall A B C D : Point,
	A <> C ->
	Between B A D ->
	Supplement B A C C A D.
Proof.
	intros A B C D Hac H.
	assert (Hab : A <> B).
	 immediate7.
	 assert (Had : A <> D).
	  immediate7.
	  setAngle6 B A C ipattern:(alpha).
	    setAngle6 C A D ipattern:(beta).
	    setMarkSegmentPoint5 A B Oo Uu ipattern:(b); fold b in |- *.
	    setMarkSegmentPoint5 A C Oo Uu ipattern:(c); fold c in |- *.
	    setMarkSegmentPoint5 A D Oo Uu ipattern:(d); fold d in |- *.
	    since7 (Between b A d).
	   from7 H5 (OpenRay A D d).
	      step7 H4.
	    step7 H6.
	      from7 H1 (OpenRay A B b).
	       step7 H0.
	     step7 H7.
	   since7 (Distance b d = Distance Uu uU).
	    usingChasles2 b A d.
	      usingChasles2 Uu Oo uU.
	     step7 H0.
	     assert (Hb := BetweenUuOouU); immediate7.
	    byApartCases3 d b c.
	     immediate7.
	     since7 (TCongruent (Tr d A c) (Tr Uu Oo beta)).
	      step7 3.
	       step7 H2.
	         unfold beta in |- *; immediate7.
	       from7 H3 (CongruentAngle c A d C A D).
	          step7 H2.
	        step7 H10.
	          unfold beta in |- *; apply CongruentAngleUuOoAngle.
	      since7 (TCongruent (Tr b d c) (Tr uU Uu beta)).
	       step7 3.
	        step7 H10.
	        from7 H6 (CongruentAngle b d c A d c).
	         step7 H11.
	           from7 BetweenUuOouU (CongruentAngle uU Uu beta Oo Uu beta).
	            from7 H10 (Distance d c = Distance Uu beta).
	           step7 H12.
	          assert (H12 := BetweenUuOouU); immediate7.
	          step7 H12.
	            step7 H10.
	       apply (EqAngleSupplement B A C C A D Hab Hac Hac Had).
	         destructAngle B A C Hab Hac ipattern:(gamma).
	         apply H15; repeat split.
	        unfold Supplementary in |- *; immediate7.
	        rewrite <- EqDistanceUuSupplementary.
	          fold beta b c in |- *; step7 H11.
	        unfold Supplementary in |- *; immediate7.
	     since7 (TCongruent (Tr b A c) (Tr Uu Oo alpha)).
	      step7 3.
	       step7 H2.
	         unfold alpha in |- *; immediate7.
	       from7 H3 (CongruentAngle b A c B A C).
	          step7 H2.
	        step7 H10.
	          unfold alpha in |- *; apply CongruentAngleUuOoAngle.
	      since7 (TCongruent (Tr d b c) (Tr uU Uu alpha)).
	       step7 3.
	        step7 H10.
	        from7 H6 (CongruentAngle d b c A b c).
	         step7 H11.
	           from7  BetweenUuOouU (CongruentAngle uU Uu alpha Oo Uu alpha).
	            from7 H10 (Distance b c = Distance Uu alpha).
	           step7 H12.
	          assert (H12 := BetweenUuOouU); immediate7.
	          step7 H12.
	            step7 H10.
	       apply SupplementSym.
	         apply (EqAngleSupplement C A D B A C Hac Had Hab Hac).
	         destructAngle C A D Hac Had ipattern:(gamma).
	         apply H15; repeat split.
	        unfold Supplementary in |- *; immediate7.
	        rewrite <- EqDistanceUuSupplementary.
	          fold alpha c d in |- *; step7 H11.
	        unfold Supplementary in |- *; immediate7.
Qed.

Lemma ClockwiseSupplementAnglesBetween : forall A B C D : Point,
	~Clockwise C A B ->
	~Clockwise D A C ->
	Supplement C A D  B A C ->
	Between B A D.
Proof.
	intros.
	inversion H1.
	setOppSegmentPoint5 A B A D ipattern:(E).
	since7 (Supplement C A E B A C).
	 apply SupplementSym; apply BetweenSupplementAngles.
	  immediate7.
	  step7 H4.
	    step7 H3.
	 since7 (CongruentAngle C A D C A E).
	  apply (SupplementSupplementCongruent C A D C A E B A C); immediate7.
	  from7 H6 (D = E).
	     contrapose0 H.
	     step7 H4.
	   step7 H7.
	     step7 H4.
Qed.

Lemma AntiClockwiseSupplementAnglesBetween : forall A B C D : Point,
	~Clockwise B A C ->
	~Clockwise C A D ->
	Supplement C A D B A C ->
	Between B A D.
Proof.
	intros.
	inversion H1.
	setOppSegmentPoint5 A B A D ipattern:(E).
	since7 (Supplement C A E B A C).
	 apply SupplementSym; apply BetweenSupplementAngles.
	  immediate7.
	  step7 H4.
	    step7 H3.
	 since7 (CongruentAngle D A C E A C).
	  apply CongruentAngleRev;
	   apply (SupplementSupplementCongruent C A D C A E B A C); immediate7.
	  from7 H6 (D = E).
	     contrapose0 H.
	     step7 H4.
	   step7 H7.
	     step7 H4.
Qed.

Lemma SupplementUuuU : Supplement Uu Oo Uu Uu Oo uU.
Proof.
	apply BetweenSupplementAngles; immediate7.
Qed.

Lemma NullElongatedSupplement : forall A B C D E F : Point,
	NullAngle A B C ->
	ElongatedAngle D E F ->
	Supplement A B C D E F.
Proof.
	unfold NullAngle, ElongatedAngle in |- *; intros.
	apply (SupplementCongruentSupplement Uu Oo Uu).
	 apply SupplementSym; apply (SupplementCongruentSupplement Uu Oo uU).
	  apply SupplementSym; exact SupplementUuuU.
	  immediate7.
	 immediate7.
Qed.

Lemma NullSupplementElongated : forall A B C D E F : Point,
	NullAngle A B C ->
	Supplement A B C D E F ->
	ElongatedAngle D E F.
Proof.
	unfold NullAngle, ElongatedAngle in |- *; intros.
	apply (SupplementSupplementCongruent D E F Uu Oo uU A B C).
	 apply SupplementSym; exact H0.
	 apply SupplementSym; apply (SupplementCongruentSupplement Uu Oo Uu).
	  exact SupplementUuuU.
	  immediate7.
Qed.

Lemma ElongatedSupplementNull : forall A B C D E F : Point,
	ElongatedAngle D E F ->
	Supplement A B C D E F ->
	NullAngle A B C.
Proof.
	unfold NullAngle, ElongatedAngle in |- *; intros.
	apply (SupplementSupplementCongruent A B C Uu Oo Uu D E F).
	 immediate7.
	 apply SupplementSym; apply (SupplementCongruentSupplement Uu Oo uU).
	  apply SupplementSym; exact SupplementUuuU.
	  immediate7.
Qed.

Lemma TriangleBetween : forall A B C I J K L M : Point,
	Clockwise I J K  ->
	Clockwise I K L  ->
	Clockwise I L M  ->
	CongruentAngle C A B J I K ->
	CongruentAngle A B C K I L  ->
	CongruentAngle B C A L I M  ->
	Between J I M.
Proof.
	intros.
	setMarkSegmentPoint5 I K A B ipattern:(K').
	setMarkSegmentPoint5 I L B C ipattern:(L').
	from7 2 (TCongruent (Tr I K' L') (Tr B A C)).
	   from7 H7 (CongruentAngle L' I K' L I K).
	   step7 H9; immediate7.
	   step7 H6; immediate7.
	  step7 H11; immediate7.
	  apply (SumAngles I J K' L' M).
	   step7 H7.
	     step7 H6; immediate7.
	   step7 H7.
	    step7 H6; immediate7.
	    step7 H10.
	      step7 H9; immediate7.
	   step7 H10.
	     step7 H9; immediate7.
	   step7 H11.
	    step7 H6; immediate7.
	    since7 (Distance K' L' = Distance A C).
	     step7 H12; immediate7.
	    step7 H2.
	      step7 H7.
	   step7 H11.
	    since7 (Distance K' L' = Distance A C).
	     step7 H12; immediate7.
	    step7 H9; immediate7.
	    step7 H4.
	      step7 H10.
Qed.

Lemma TriangleSupplement : forall A B C I J K L M : Point,
	Clockwise I J K  ->
	Clockwise I K L  ->
	Clockwise I L M  ->
	CongruentAngle C A B J I K ->
	CongruentAngle A B C K I L  ->
	CongruentAngle B C A L I M  ->
	Supplement J I L L I M.
Proof.
	intros.
	apply BetweenSupplementAngles.
	 immediate7.
	 apply (TriangleBetween A B C I J K L M); immediate7.
Qed.

Lemma TriangleSumSupplement : forall A B C I J K L : Point,
	Clockwise I J K  ->
	Clockwise I K L  ->
	CongruentAngle C A B J I K ->
	CongruentAngle A B C K I L  ->
	Supplement J I L B C A.
Proof.
	intros.
	since7 (~ Collinear A B C).
	 intro.
	   by2Cases1 H3.
	  since7 (OpenRay I K J).
	   apply NullAngleOpenRay.
	     step7 H1.
	     step7 H4.
	     step7 H4.
	     immediate7.
	   contradict1 H H5.
	  since7 (OpenRay I K L).
	   apply NullAngleOpenRay.
	     step7 H2.
	   contradict1 H0 H5.
	 setMarkSegmentPoint5 I L B C ipattern:(L').
	   setTCongruentClockwise7 B C A L' I ipattern:(M).
	   from7 H10 (CongruentAngle B C A L I M).
	    step7 H6.
	  apply SupplementSym;
	   apply (SupplementCongruentSupplement L I M B C A J I L).
	   apply SupplementSym; apply (TriangleSupplement A B C I J K L M);  try immediate7.
	     step7 H11.
	   immediate7.
Qed.

Lemma TriangleSumClockwise : forall A B C I J K L M : Point,
	Clockwise I J K  ->
	Clockwise I K L  ->
	CongruentAngle C A B J I K ->
	CongruentAngle A B C K I L  ->
	Between J I M ->
	Clockwise I L M.
Proof.
	intros.
	setMarkSegmentPoint5 I L B C ipattern:(L').
	setTCongruentClockwise7 B C A L' I ipattern:(M').
	 intro; from7 H1 (Collinear J I K).
	  contradict1 H H8.
	 since7 (Between J I M').
	  apply (TriangleBetween A B C I J K L M').
	   immediate7.
	   immediate7.
	   step7 H6.
	   immediate7.
	   immediate7.
	   step7 H10.
	     step7 H6.
	  step7 H3.
	    right; step7 H6.
	    step7 H12.
Qed.

End SUPPLEMENT.


Require Export ProjectiveGeometry.Dev.projective_space_axioms.
Require Export ProjectiveGeometry.Dev.p_equiv_c3p.

(*****************************************************************************)
(** Coplanar **)

Section s_psohEquivCop.

Context `{PPS : PreProjectiveSpace}.
Context `{EP : EqDecidability Point}.
Context `{OP : OrderedType Point}.
Context `{EL : EqDecidabilityL Line}.

(*** Definition dist4 ***)
Definition dist4 (a b c d : Point) :=
 ~ a [==] b /\ ~ a [==] c /\ ~ a [==] d /\
 ~ b [==] c /\ ~ b [==] d /\ ~ c [==] d.

Context `{ELI : EqDecidabilityP Line Intersect}.

(*** Definition coplanar ***)
Definition coplanar (a b c d : Point) : bool :=
if (eq_dec_u a b)
   then true
   else if (eq_dec_u c d)
        then true
        else let l1 := (proj1_sig (a1_exist a b)) in
             let l2 := (proj1_sig (a1_exist c d)) in
             if (eq_dec_l l1 l2) then true
             else if (eq_dec_p l1 l2) then true
             else false.

Lemma cop_1 : forall a b c, coplanar a a b c = true.
Proof.
intros.
unfold coplanar.
case_eq (eq_dec_u a a).
intros.
reflexivity.
intros.
apply False_ind.
apply n.
reflexivity.
Qed.

Lemma cop_2 : forall a b c, coplanar a b b c = true.
Proof.
intros.
unfold coplanar.
case_eq (eq_dec_u a b).
intros.
reflexivity.
intros.
case_eq (eq_dec_u b c).
intros.
reflexivity.
intros.
destruct (a1_exist a b).
intros.
simpl.
destruct (a1_exist b c).
simpl.
case_eq (eq_dec_l x x0).
intros.
reflexivity.
intros.
case_eq (eq_dec_p x x0).
intros.
reflexivity.
intros.
destruct a0.
destruct a1.
assert( Intersect x x0).
unfold Intersect.
exists b.
split.
assumption.
assumption.
contradiction.
Qed.

Lemma cop_3 : forall a b c, coplanar a b c c = true.
Proof.
intros.
unfold coplanar.
case_eq (eq_dec_u a b).
intros.
reflexivity.
intros.
case_eq (eq_dec_u c c).
intros.
reflexivity.
intros.
apply False_ind.
apply n0.
reflexivity.
Qed.

Lemma cop_exchange1 : forall a b c d, coplanar a b c d = coplanar b a c d.
Proof.
intros.
unfold coplanar.
case_eq (eq_dec_u a b).
intros.
case_eq (eq_dec_u b a).
intros.
reflexivity.
intros.
assert(HH := eq_reverse a b e).
contradiction.
intros.
case_eq (eq_dec_u c d).
intros.
case_eq (eq_dec_u b a).
intros.
reflexivity.
intros.
reflexivity.
intros.
destruct (a1_exist a b).
simpl.
destruct (a1_exist c d).
simpl.
case_eq (eq_dec_l x x0).
intros.
case_eq (eq_dec_u b a).
intros.
reflexivity.
intros.
destruct (a1_exist b a).
simpl.
case_eq (eq_dec_l x1 x0).
intros.
reflexivity.
intros.
case_eq (eq_dec_p x1 x0).
intros.
reflexivity.
intros.
clear H1 H2 H3 H4.
rewrite <-e in *.
destruct a0.
destruct a2.
assert( HH0 : Intersect x1 x).
unfold Intersect.
exists b.
split.
assumption.
assumption.
contradiction.
intros.
case_eq (eq_dec_p x x0).
intros.
case_eq (eq_dec_u b a).
intros.
reflexivity.
intros.
destruct (a1_exist b a).
simpl.
case_eq (eq_dec_l x1 x0).
intros.
reflexivity.
intros.
case_eq (eq_dec_p x1 x0).
intros.
reflexivity.
intros.
clear H1 H2 H3 H4.
destruct a0.
destruct a2.
assert( HH0 := uniqueness a b x x1 H1 H2 H4 H3).
destruct HH0.
contradiction.
rewrite H6 in i.
contradiction.
intros.
case_eq (eq_dec_u b a).
intros.
assert( HH0 := eq_reverse b a e).
contradiction.
intros.
destruct (a1_exist b a).
simpl.
case_eq (eq_dec_l x1 x0).
intros.
clear H1 H2 H3 H4.
destruct a0.
destruct a2.
assert( HH0 := uniqueness a b x x1 H1 H2 H4 H3).
destruct HH0.
contradiction.
rewrite H5 in n1.
rewrite e in n1.
apply False_ind.
apply n1.
reflexivity.
intros.
case_eq (eq_dec_p x1 x0).
intros.
clear H1 H2 H3 H4.
destruct a0.
destruct a2.
assert( HH0 := uniqueness a b x x1 H1 H2 H4 H3).
destruct HH0.
contradiction.
rewrite H6 in n2.
contradiction.
intros.
reflexivity.
Qed.

Lemma cop_exchange2 : forall a b c d, coplanar a b c d = coplanar a b d c.
Proof.
intros.
unfold coplanar.
case_eq (eq_dec_u a b).
intros.
reflexivity.
intros.
case_eq (eq_dec_u c d).
intros.
case_eq (eq_dec_u d c).
intros.
reflexivity.
intros.
assert( HH0 := eq_reverse c d e).
contradiction.
intros.
destruct (a1_exist c d).
simpl.
destruct (a1_exist a b).
simpl.
case_eq (eq_dec_l x0 x).
intros.
case_eq (eq_dec_u d c).
intros.
reflexivity.
intros.
destruct (a1_exist d c).
simpl.
case_eq (eq_dec_l x0 x1).
intros.
reflexivity.
intros.
case_eq (eq_dec_p x0 x1).
intros.
reflexivity.
intros.
clear H0 H1 H2 H3 H4.
assert( HH0 : Intersect x x1).
unfold Intersect.
exists c.
destruct a0.
destruct a2.
split.
assumption.
assumption.
rewrite e in *.
contradiction.
intros.
case_eq (eq_dec_p x0 x).
intros.
case_eq (eq_dec_u d c).
intros.
reflexivity.
intros.
destruct (a1_exist d c).
simpl.
case_eq (eq_dec_l x0 x1).
intros.
reflexivity.
intros.
case_eq (eq_dec_p x0 x1).
intros.
reflexivity.
intros.
clear H1 H2 H3 H4.
destruct a0.
destruct a2.
assert( HH0 := uniqueness c d x x1 H1 H2 H4 H3).
destruct HH0.
contradiction.
rewrite H6 in *.
contradiction.
intros.
case_eq (eq_dec_u d c).
intros.
assert( HH0 := eq_reverse d c e).
contradiction.
intros.
case_eq (a1_exist d c).
simpl.
intros.
case_eq (eq_dec_l x0 x1).
intros.
clear H1 H2 H3 H4.
destruct a0.
destruct a2.
assert( HH0 := uniqueness c d x x1 H1 H2 H4 H3).
destruct HH0.
contradiction.
rewrite H6 in *.
rewrite e in *.
apply False_ind.
apply n1.
reflexivity.
intros.
case_eq (eq_dec_p x0 x1).
intros.
clear H1 H2 H3 H4.
destruct a0.
destruct a2.
assert( HH0 := uniqueness c d x x1 H1 H2 H4 H3).
destruct HH0.
contradiction.
rewrite H7 in *.
contradiction.
intros.
reflexivity.
Qed.

Lemma cop_exchange3 : forall a b c d, coplanar a b c d = coplanar a c b d.
Proof.
intros.
unfold coplanar.
case_eq (eq_dec_u a b).
intros.
case_eq (eq_dec_u a c).
intros.
reflexivity.
intros.
case_eq (eq_dec_u b d).
intros.
reflexivity.
intros.
destruct (a1_exist a c).
simpl.
destruct (a1_exist b d).
simpl.
case_eq (eq_dec_l x x0).
intros.
reflexivity.
intros.
case_eq (eq_dec_p x x0).
intros.
reflexivity.
intros.
rewrite e in *.
assert( HH0 : Intersect x x0).
unfold Intersect.
exists b.
destruct a0; destruct a1.
split.
assumption. assumption. contradiction.
case_eq (eq_dec_u c d).
intros.
case_eq (eq_dec_u a c).
intros.
reflexivity.
intros.
case_eq (eq_dec_u b d).
intros.
reflexivity.
destruct (a1_exist a c).
intros.
destruct (a1_exist b d).
simpl.
case_eq (eq_dec_l x x0).
intros.
reflexivity.
intros.
case_eq (eq_dec_p x x0).
intros.
reflexivity.
intros.
rewrite e in *.
assert( HH0 : Intersect x x0).
unfold Intersect.
exists d.
destruct a0; destruct a1.
split.
assumption. assumption. contradiction.
intros.
destruct (a1_exist a b).
simpl.
destruct (a1_exist c d).
simpl.
case_eq (eq_dec_l x x0).
intros.
case_eq (eq_dec_u a c).
intros.
reflexivity.
case_eq (eq_dec_u b d).
intros.
reflexivity.
intros.
destruct (a1_exist a c).
simpl.
destruct (a1_exist b d).
simpl.
case_eq (eq_dec_l x1 x2).
intros.
reflexivity.
intros.
destruct (eq_dec_p x1 x2).
reflexivity.
rewrite e in *.
destruct a0; destruct a1; destruct a2; destruct a3.
assert( HH0 := uniqueness a c x0 x1 H5 H7 H9 H10).
destruct HH0.
contradiction.
assert( HH0 := uniqueness b d x0 x2 H6 H8 H11 H12).
destruct HH0.
contradiction.
rewrite H13 in H14.
contradiction.
intros.
case_eq (eq_dec_p x x0).
intros.
case_eq (eq_dec_u a c).
intros.
reflexivity.
intros.
case_eq (eq_dec_u b d).
intros.
reflexivity.
intros.
destruct (a1_exist a c).
simpl.
destruct (a1_exist b d).
simpl.
destruct (eq_dec_l x1 x2).
reflexivity.
case_eq (eq_dec_p x1 x2).
intros.
reflexivity.
intros.
destruct a0; destruct a1 ; destruct a2; destruct a3.
case_eq (eq_dec_u b c).
intros.
rewrite e in *.
assert( HH0 : Intersect x1 x2); unfold Intersect.
exists c.
split.
assumption. assumption. contradiction.
case_eq (eq_dec_u a d).
intros.
rewrite e in *.
assert( HH0 : Intersect x1 x2); unfold Intersect.
exists d.
split.
assumption. assumption. contradiction.
intros.
assert( HH0 : dist4 a b c d).
unfold dist4.
split. assumption. split. assumption. split. assumption. split. assumption. split. assumption. assumption.
assert( HH1 : Incid a x /\ Incid b x).
split. assumption. assumption.
assert( HH2 : Incid c x0 /\ Incid d x0).
split. assumption. assumption.
assert( HH3 : Incid a x1 /\ Incid c x1).
split. assumption. assumption.
assert( HH4 : Incid b x2 /\ Incid d x2).
split. assumption. assumption.
unfold Intersect in i.
destruct i.
assert( HH5 : exists I : Point, Incid I x /\ Incid I x0).
exists x3.
destruct a0.
split. assumption. assumption.
assert( HH6 := a2 a b c d x x0 x1 x2 HH0 HH1 HH2 HH3 HH4 HH5).
destruct HH6.
destruct H16.
assert( HH6 : Intersect x1 x2); unfold Intersect.
exists x4.
split. assumption. assumption.
contradiction.
case_eq (eq_dec_u a c).
intros.
rewrite e in *.
assert( HH0 : Intersect x x0); unfold Intersect.
destruct a0; destruct a1.
exists c.
split. assumption. assumption.
contradiction.
intros.
case_eq (eq_dec_u b d).
intros.
rewrite e in *.
assert( HH0 : Intersect x x0); unfold Intersect.
destruct a0; destruct a1.
exists d.
split. assumption. assumption.
contradiction.
intros.
destruct (a1_exist a c).
simpl.
destruct (a1_exist b d).
simpl.
case_eq (eq_dec_l x1 x2).
intros.
rewrite e in *.
destruct a0; destruct a1; destruct a2; destruct a3.
assert( HH0 := uniqueness a b x x2 H6 H7 H10 H12).
destruct HH0.
contradiction.
assert( HH0 := uniqueness c d x0 x2 H8 H9 H11 H13).
destruct HH0.
contradiction.
rewrite <-H15 in H14.
contradiction.
intros.
case_eq (eq_dec_p x1 x2).
intros.
case_eq (eq_dec_u b c).
intros.
rewrite e in *.
assert( HH0 : Intersect x x0); unfold Intersect.
exists c.
destruct a0; destruct a1; split.
assumption. assumption. contradiction.
intros.
case_eq (eq_dec_u a d).
intros.
rewrite e in *.
assert( HH0 : Intersect x x0); unfold Intersect.
exists d.
destruct a0; destruct a1; split.
assumption. assumption. contradiction.
intros.
assert( HH0 : dist4 a c b d).
unfold dist4.
split. assumption. split. assumption. split. assumption. split.
intro; clear H7; rewrite H9 in *. apply n6; reflexivity.
split. assumption. assumption.
destruct a0; destruct a1; destruct a2; destruct a3.
assert( HH1 : Incid a x1 /\ Incid c x1).
split. assumption. assumption.
assert( HH2 : Incid b x2 /\ Incid d x2).
split. assumption. assumption.
assert( HH3 : Incid a x /\ Incid b x).
split. assumption. assumption.
assert( HH4 : Incid c x0 /\ Incid d x0).
split. assumption. assumption.
assert( HH5 : exists I : Point, Incid I x1 /\ Incid I x2).
unfold Intersect in i.
destruct i.
exists x3.
destruct a0.
split.
assumption. assumption.
assert( HH6 := a2 a c b d x1 x2 x x0 HH0 HH1 HH2 HH3 HH4 HH5).
destruct HH6.
destruct H17.
assert( HH6 : Intersect x x0); unfold Intersect.
exists x3.
split. assumption. assumption.
contradiction.
intros.
reflexivity.
Qed.

Lemma cop_shift_aux : forall x x0, Intersect x x0 -> Intersect x0 x.
Proof.
intros.
unfold Intersect in *.
destruct H.
exists x1.
destruct H.
simpl.
split.
assumption.
assumption.
Qed.

Lemma cop_shift : forall a b c d, coplanar a b c d = coplanar c d a b.
Proof.
intros.
unfold coplanar.
case_eq (eq_dec_u a b).
intros.
case_eq (eq_dec_u c d).
intros.
reflexivity.
intros.
reflexivity.
intros.
case_eq (eq_dec_u c d).
intros.
reflexivity.
intros.
destruct (a1_exist c d).
simpl.
destruct (a1_exist a b).
simpl.
case_eq (eq_dec_l x0 x).
intros.
case_eq (eq_dec_l x x0).
intros.
reflexivity.
intros.
clear H2.
rewrite e in n1.
apply False_ind.
apply n1.
reflexivity.
intros.
case_eq (eq_dec_p x0 x).
intros.
case_eq (eq_dec_l x x0).
intros.
reflexivity.
intros.
case_eq (eq_dec_p x x0).
intros.
reflexivity.
intros.
assert( HH0 := cop_shift_aux x0 x i).
contradiction.
intros.
case_eq (eq_dec_l x x0).
intros.
clear H1.
rewrite e in n1.
apply False_ind.
apply n1.
reflexivity.
intros.
case_eq (eq_dec_p x x0).
intros.
assert( HH0 := cop_shift_aux x x0 i).
contradiction.
intros.
reflexivity.
Qed.

Lemma cop_trans : forall a b c d e, collinear a b c = false -> coplanar a b c d = true -> coplanar a b c e = true -> coplanar a b d e = true.
Proof.
unfold coplanar.
intros a b c d e H.
case_eq (eq_dec_u a b).
intros.
reflexivity.
case_eq (eq_dec_u c d).
case_eq (eq_dec_u c e).
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist a b).
simpl.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x x0).
intros.
reflexivity.
intros.
case_eq (eq_dec_p x x0).
intros.
reflexivity.
intros.
clear H0 H1 H2 H3 H4 H5 H6 H7.
rewrite e0 in *.
rewrite e1 in *.
apply False_ind.
apply n0.
reflexivity.
destruct (a1_exist a b).
simpl.
destruct (a1_exist c e).
simpl.
case_eq (eq_dec_l x x0).
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x x1).
intros.
reflexivity.
case_eq (eq_dec_p x x1).
intros.
reflexivity.
intros.
clear H0 H1 H2 H3 H4 H5 H6 H7 H8.
rewrite e0 in *.
rewrite e1 in *.
destruct a1.
destruct a2.
assert( HH0 := uniqueness d e x0 x1 H0 H1 H2 H3).
destruct HH0.
contradiction.
rewrite H4 in *.
apply False_ind.
apply n0.
reflexivity.
case_eq (eq_dec_p x x0).
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x x1).
intros.
reflexivity.
case_eq (eq_dec_p x x1).
intros.
reflexivity.
intros.
clear H0 H1 H2 H3 H4 H5 H6 H7 H8 H9.
rewrite e0 in *.
destruct a1.
destruct a2.
assert( HH0 := uniqueness d e x0 x1 H0 H1 H2 H3).
destruct HH0.
contradiction.
rewrite H4 in *.
contradiction.
intros.
inversion H6.
destruct (a1_exist a b).
simpl.
destruct (a1_exist c d).
simpl.
case_eq (eq_dec_l x x0).
case_eq (eq_dec_u c e).
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x x1).
intros.
reflexivity.
case_eq (eq_dec_p x x1).
intros.
reflexivity.
intros.
clear H0 H1 H2 H3 H4 H5 H6 H7 H8.
rewrite e0 in *.
rewrite e1 in *.
destruct a1.
destruct a2.
assert( HH0 := uniqueness d e x0 x1 H1 H0 H2 H3).
destruct HH0.
contradiction.
rewrite H4 in *.
apply False_ind.
apply n0.
reflexivity.
destruct (a1_exist c e).
simpl.
case_eq (eq_dec_l x x1).
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x x2).
intros.
reflexivity.
case_eq (eq_dec_p x x2).
intros.
reflexivity.
intros.
clear H0 H1 H2 H3 H4 H5 H6 H7 H8 H9.
rewrite e0 in *.
rewrite e1 in *.
destruct a1.
destruct a2.
destruct a3.
assert( HH0 := uniqueness d e x0 x2 H1 H3 H4 H5).
destruct HH0.
contradiction.
rewrite H6 in *.
apply False_ind.
apply n0.
reflexivity.
case_eq (eq_dec_p x x1).
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x x2).
intros.
reflexivity.
case_eq (eq_dec_p x x2).
intros.
reflexivity.
intros.
clear H0 H1 H2 H3 H4 H5 H6 H7 H8 H9 H10.
rewrite e0 in *.
assert( HH0 : Intersect x0 x2).
unfold Intersect.
exists d.
destruct a1.
destruct a3.
split.
assumption.
assumption.
contradiction.
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x x2).
intros.
reflexivity.
case_eq (eq_dec_p x x2).
intros.
reflexivity.
intros.
inversion H10.
case_eq (eq_dec_p x x0).
case_eq (eq_dec_u c e).
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x x1).
intros.
reflexivity.
case_eq (eq_dec_p x x1).
intros.
reflexivity.
intros.
clear H0 H1 H2 H3 H4 H5 H6 H7 H8 H9.
rewrite e0 in *.
destruct a1.
destruct a2.
assert( HH0 := uniqueness d e x0 x1 H1 H0 H2 H3).
destruct HH0.
contradiction.
rewrite H4 in *.
contradiction.
destruct (a1_exist c e).
simpl.
case_eq(eq_dec_l x x1).
case_eq( eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x x2).
intros.
reflexivity.
case_eq (eq_dec_p x x2).
reflexivity.
intros.
clear H0 H1 H2 H3 H4 H5 H6 H7 H8 H9 H10.
rewrite e0 in *.
assert( HH0 : Intersect x1 x2).
unfold Intersect.
exists e.
destruct a2.
destruct a3.
split.
assumption.
assumption.
contradiction.
case_eq (eq_dec_p x x1).
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct( a1_exist d e).
simpl.
case_eq( eq_dec_l x x2).
intros.
reflexivity.
case_eq( eq_dec_p x x2).
intros.
reflexivity.
intros.
clear H0 H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11.

unfold Intersect in i.
destruct i.
unfold Intersect in i0.
destruct i0.
case_eq (eq_dec_u x4 x3).
intros.
rewrite e0 in *.
destruct a1.
destruct a2.
destruct H0.
destruct H1.
assert( HH0 := uniqueness x3 c x0 x1 H8 H3 H7 H5).
destruct HH0.
rewrite H9 in *.
assert( HH0 : collinear a b c = true).
unfold collinear.
case_eq (eq_dec_u a b).
intros.
reflexivity.
intros.
destruct (a1_exist a b).
simpl.
case_eq (incid_dec c x5).
intros.
reflexivity.
intros.
destruct a0.
destruct a1.
assert( HH0 := uniqueness a b x x5 H12 H13 H14 H15).
destruct HH0.
contradiction.
rewrite H16 in *.
contradiction.
rewrite HH0 in H.
inversion H.
rewrite H9 in *.
destruct a3.
assert( HH0 := uniqueness d e x1 x2 H4 H6 H10 H11).
destruct HH0.
contradiction.
rewrite H12 in *.
assert( HH0 : Intersect x x2).
unfold Intersect.
exists x3.
split.
assumption.
assumption.
contradiction.
intros.
case_eq(eq_dec_u x3 d).
intros.
rewrite e0 in *.
assert( HH0 : Intersect x x2).
unfold Intersect.
exists d.
destruct a3.
destruct H0.
split.
assumption.
assumption.
contradiction.
intros.
case_eq(eq_dec_u x3 e).
intros.
rewrite e0 in *.
assert( HH0 : Intersect x x2).
unfold Intersect.
exists e.
destruct a3.
destruct H0.
split.
assumption.
assumption.
contradiction.
intros.
case_eq(eq_dec_u x4 d).
intros.
rewrite e0 in *.
assert( HH0 : Intersect x x2).
unfold Intersect.
exists d.
destruct a3.
destruct H1.
split.
assumption.
assumption.
contradiction.
intros.
case_eq(eq_dec_u x4 e).
intros.
rewrite e0 in *.
assert( HH0 : Intersect x x2).
unfold Intersect.
exists e.
destruct a3.
destruct H1.
split.
assumption.
assumption.
contradiction.
intros.
assert( HH0 : dist4 x4 d x3 e).
unfold dist4.
split.
assumption.
split.
assumption.
split.
assumption.
split.
intro.
clear H3.
rewrite H7 in *.
apply n8.
reflexivity.
split.
assumption.
assumption.
destruct a0.
destruct a1.
destruct a2.
destruct a3.
destruct H0.
destruct H1.
assert( HH1 : Incid x4 x0 /\ Incid d x0).
split.
assumption.
assumption.
assert( HH2 : Incid x3 x1 /\ Incid e x1).
split.
assumption.
assumption.
assert( HH3 : Incid x4 x /\ Incid x3 x).
split.
assumption.
assumption.
assert( HH4 : Incid d x2 /\ Incid e x2).
split.
assumption.
assumption.
assert( HH5 : exists I : Point, Incid I x0 /\ Incid I x1).
exists c.
split.
assumption.
assumption.
assert( HH6 := a2 x4 d x3 e x0 x1 x x2 HH0 HH1 HH2 HH3 HH4 HH5).
destruct HH6.
assert( Intersect x x2).
unfold Intersect.
exists x5.
destruct H17.
split.
assumption.
assumption.
contradiction.
case_eq (eq_dec_u d e).
intros.
reflexivity.
intros.
inversion H9.
intros.
inversion H4.
Qed.

Lemma cop_trans_bis : forall a b c d e, collinear a b c = false -> coplanar a b c d = true -> coplanar a b c e = true -> coplanar a c d e = true.
Proof.
unfold coplanar.
intros a b c d e H.
case_eq (eq_dec_u a b).
case_eq (eq_dec_u a c).
intros.
reflexivity.
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist d e).
simpl.
destruct (a1_exist a c).
simpl.
case_eq (eq_dec_l x0 x).
intros.
reflexivity.
case_eq (eq_dec_p x0 x).
intros.
reflexivity.
intros.
clear H1 H2 H3 H4 H5 H6.
rewrite e0 in *.
assert( HH0 := col_1 b c).
rewrite HH0 in H.
inversion H.
case_eq (eq_dec_u c d).
case_eq (eq_dec_u c e).
case_eq (eq_dec_u a c).
intros.
reflexivity.
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist d e).
simpl.
destruct (a1_exist a c).
simpl.
case_eq (eq_dec_l x0 x).
intros.
reflexivity.
case_eq (eq_dec_p x0 x).
intros.
reflexivity.
intros.
clear H1 H2 H3 H4 H5 H6 H7 H8.
rewrite e0 in *.
rewrite e1 in *.
apply False_ind.
apply n1.
reflexivity.
destruct (a1_exist c e).
simpl.
destruct (a1_exist a b).
simpl.
case_eq (eq_dec_l x0 x).
case_eq (eq_dec_u a c).
intros.
reflexivity.
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist a c).
simpl.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x1 x2).
intros.
reflexivity.
case_eq (eq_dec_p x1 x2).
intros.
reflexivity.
intros.
clear H1 H2 H3 H4 H5 H6 H7 H8 H9.
rewrite e0 in *.
rewrite e1 in *.
destruct a0.
destruct a3.
assert( HH0 := uniqueness d e x x2 H1 H2 H3 H4).
destruct HH0.
contradiction.
rewrite H5 in *.
assert( HH0 : Intersect x1 x2).
unfold Intersect.
exists d.
destruct a2.
split.
assumption.
assumption.
contradiction.
case_eq (eq_dec_p x0 x).
case_eq (eq_dec_u a c).
intros.
reflexivity.
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist a c).
simpl.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x1 x2).
intros.
reflexivity.
case_eq (eq_dec_p x1 x2).
intros.
reflexivity.
intros.
clear H1 H2 H3 H4 H5 H6 H7 H8 H9 H10.
rewrite e0 in *.
destruct a0.
destruct a3.
assert( HH0 := uniqueness d e x x2 H1 H2 H3 H4).
destruct HH0.
contradiction.
rewrite H5 in *.
assert( HH0 : Intersect x1 x2).
unfold Intersect.
exists d.
destruct a2.
split.
assumption.
assumption.
contradiction.
intros.
inversion H6.
destruct (a1_exist a b).
simpl.
destruct (a1_exist c d).
simpl.
case_eq (eq_dec_l x x0).
case_eq (eq_dec_u c e).
case_eq (eq_dec_u a c).
intros.
reflexivity.
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist a c).
simpl.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x1 x2).
intros.
reflexivity.
case_eq (eq_dec_p x1 x2).
intros.
reflexivity.
intros.
clear H1 H2 H3 H4 H5 H6 H7 H8 H9.
rewrite e0 in *.
rewrite e1 in *.
destruct a1.
destruct a3.
assert( HH0 := uniqueness d e x0 x2 H2 H1 H3 H4).
destruct HH0.
contradiction.
rewrite H5 in *.
assert( HH0 : Intersect x1 x2).
unfold Intersect.
exists e.
destruct a2.
split.
assumption.
assumption.
contradiction.
destruct (a1_exist c e).
simpl.
case_eq (eq_dec_l x x1).
case_eq (eq_dec_u a c).
intros.
reflexivity.
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist a c).
simpl.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x2 x3).
intros.
reflexivity.
case_eq (eq_dec_p x2 x3).
intros.
reflexivity.
intros.
clear H1 H2 H3 H4 H5 H6 H7 H8 H9 H10.
rewrite e0 in *.
rewrite e1 in *.
destruct a1.
destruct a2.
destruct a4.
assert( HH0 := uniqueness d e x0 x3 H2 H4 H5 H6).
destruct HH0.
contradiction.
rewrite H7 in *.
destruct a0.
destruct a3.
assert( HH0 := uniqueness a c x2 x3 H10 H11 H8 H1).
destruct HH0.
contradiction.
rewrite H12 in *.
apply False_ind.
apply n0.
reflexivity.
case_eq (eq_dec_p x x1).
case_eq (eq_dec_u a c).
intros.
reflexivity.
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist a c).
simpl.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x2 x3).
intros.
reflexivity.
case_eq (eq_dec_p x2 x3).
intros.
reflexivity.
intros.
clear H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11.
rewrite e0 in *.
destruct a0.
destruct a1.
destruct a3.
assert( HH0 := uniqueness a c x0 x2 H1 H3 H5 H6).
destruct HH0.
contradiction.
rewrite H7 in *.
assert( HH0 : Intersect x2 x3).
unfold Intersect.
exists d.
destruct a4.
split.
assumption.
assumption.
contradiction.
intros.
inversion H7.
case_eq (eq_dec_p x x0).
case_eq (eq_dec_u c e).
case_eq (eq_dec_u a c).
intros.
reflexivity.
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist a c).
simpl.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x1 x2).
intros.
reflexivity.
case_eq (eq_dec_p x1 x2).
intros.
reflexivity.
intros.
clear H1 H2 H3 H4 H5 H6 H7 H8 H9 H10.
rewrite e0 in *.
destruct a1.
destruct a3.
assert( HH0 := uniqueness d e x0 x2 H2 H1 H3 H4).
destruct HH0.
contradiction.
rewrite H5 in *.
assert( HH0 : Intersect x1 x2).
unfold Intersect.
exists e.
destruct a2.
split.
assumption.
assumption.
contradiction.
destruct (a1_exist c e).
simpl.
case_eq (eq_dec_l x x1).
case_eq (eq_dec_u a c).
intros.
reflexivity.
case_eq (eq_dec_u d e).
reflexivity.
destruct (a1_exist a c).
simpl.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x2 x3).
intros.
reflexivity.
case_eq (eq_dec_p x2 x3).
intros.
reflexivity.
intros.
clear H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11.
rewrite e0 in *.
destruct a0.
destruct a2.
destruct a3.
assert( HH0 := uniqueness a c x1 x2 H1 H3 H5 H6).
destruct HH0.
contradiction.
rewrite H7 in *.
assert( HH0 : Intersect x2 x3).
unfold Intersect.
exists e.
destruct a4.
split.
assumption.
assumption.
contradiction.
case_eq (eq_dec_p x x1).
case_eq (eq_dec_u d e).
case_eq (eq_dec_u a c).
intros.
reflexivity.
intros.
reflexivity.
case_eq (eq_dec_u a c).
intros.
reflexivity.
destruct (a1_exist a c).
simpl.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x2 x3).
intros.
reflexivity.
case_eq (eq_dec_p x2 x3).
intros.
reflexivity.
intros.
clear H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11 H12.
(* Triple Pasch *)
(* Pasch 1 *)
unfold Intersect in i.
unfold Intersect in i0.
destruct i.
destruct i0.
case_eq (eq_dec_u x4 x5).
intros.
rewrite e0 in *.
destruct a1.
destruct a2.
destruct H1.
destruct H2.
assert( HH0 := uniqueness c x5 x0 x1 H4 H9 H6 H8).
destruct HH0.
rewrite <-H10 in *.
destruct a0.
destruct a3.
assert( HH0 := uniqueness a c x x2 H11 H1 H13 H14).
destruct HH0.
contradiction.
rewrite H15 in *.
assert( HH0 : collinear a b c = true).
unfold collinear.
case_eq (eq_dec_u a b).
intros.
reflexivity.
intros.
destruct (a1_exist a b).
simpl.
case_eq (incid_dec c x6).
intros.
reflexivity.
intros.
destruct a0.
assert( HH0 := uniqueness a b x2 x6 H11 H12 H18 H19).
destruct HH0.
contradiction.
rewrite H20 in *.
contradiction.
rewrite HH0 in H.
inversion H.
rewrite H10 in *.
destruct a4.
assert( HH0 := uniqueness d e x1 x3  H5 H7 H11 H12).
destruct HH0.
contradiction.
rewrite H13 in *.
assert( HH0 : Intersect x2 x3).
unfold Intersect.
exists c.
destruct a3.
split.
assumption.
assumption.
contradiction.
intros.
case_eq (eq_dec_u x4 d).
intros.
rewrite e0 in *.
destruct a1.
destruct a2.
destruct H1.
assert( HH0 := uniqueness c d x0 x1 H5 H6 H7 H9).
destruct HH0.
contradiction.
rewrite H10 in *.
destruct a4.
assert( HH0 := uniqueness d e x1 x3 H6 H8 H11 H12).
destruct HH0.
contradiction.
rewrite H13 in *.
assert( HH0 : Intersect x2 x3).
unfold Intersect.
exists c.
destruct a3.
split.
assumption.
assumption.
contradiction.
intros.
case_eq (eq_dec_u x5 e).
intros.
rewrite e0 in *.
destruct a1.
destruct a2.
destruct H2.
assert( HH0 := uniqueness c e x0 x1 H6 H10 H8 H9).
destruct HH0.
contradiction.
rewrite H11 in *.
destruct a4.
assert( HH0 := uniqueness d e x1 x3 H7 H9 H12 H13).
destruct HH0.
contradiction.
rewrite H14 in *.
assert( HH0 : Intersect x2 x3).
unfold Intersect.
exists c.
destruct a3.
split.
assumption.
assumption.
contradiction.
intros.
(* Cas dégénéré x4 = e *)
case_eq (eq_dec_u x4 e).
intros.
case_eq (eq_dec_u a d).
intros.
rewrite e1 in *.
assert( HH0 : Intersect x2 x3).
unfold Intersect.
exists d.
destruct a3.
destruct a4.
split.
assumption.
assumption.
contradiction.
case_eq (eq_dec_u a e).
intros.
rewrite e1 in *.
assert( HH0 : Intersect x2 x3).
unfold Intersect.
exists e.
destruct a3.
destruct a4.
split.
assumption.
assumption.
contradiction.
intros.
assert( HH0 : dist4 a e c d).
unfold dist4.
split.
assumption.
split.
assumption.
split.
assumption.
split.
intro.
rewrite H9 in *.
apply n4.
reflexivity.
split.
intro.
rewrite H9 in *.
apply n2.
reflexivity.
assumption.
destruct a0.
destruct a1.
destruct a2.
destruct a3.
destruct a4.
destruct H1.
destruct H2.
rewrite e0 in *.
assert( HH1 : Incid a x /\ Incid e x).
split.
assumption.
assumption.
assert( HH2 : Incid c x0 /\ Incid d x0).
split.
assumption.
assumption.
assert( HH3 : Incid a x2 /\ Incid c x2).
split.
assumption.
assumption.
assert( HH4 : Incid e x3 /\ Incid d x3).
split.
assumption.
assumption.
assert( HH5 : exists I : Point, (Incid I x /\ Incid I x0)).
exists x5.
split.
assumption.
assumption.
assert( HH6 := a2 a e c d x x0 x2 x3 HH0 HH1 HH2 HH3 HH4 HH5).
destruct HH6.
assert( HH7 : Intersect x2 x3).
unfold Intersect.
exists x6.
destruct H21.
split.
assumption.
assumption.
contradiction.
intros.
(* Cas degenere x5 = d *)
case_eq (eq_dec_u x5 d).
intros.
rewrite e0 in *.
case_eq (eq_dec_u a d).
intros.
rewrite e1 in *.
assert( HH0 : Intersect x2 x3).
unfold Intersect.
exists d.
destruct a3.
destruct a4.
split.
assumption.
assumption.
contradiction.
intros.
case_eq (eq_dec_u a e).
intros.
rewrite e1 in *.
assert( HH0 : Intersect x2 x3).
unfold Intersect.
exists e.
destruct a3.
destruct a4.
split.
assumption.
assumption.
contradiction.
intros.
assert( HH0 : dist4 a d c e).
unfold dist4.
split.
assumption.
split.
assumption.
split.
assumption.
split.
intro.
rewrite H10 in *.
apply n6.
reflexivity.
split.
assumption.
assumption.
destruct a0.
destruct a1.
destruct a2.
destruct a3.
destruct a4.
destruct H1.
destruct H2.
assert( HH1 : Incid a x /\ Incid d x).
split.
assumption.
assumption.
assert( HH2 : Incid c x1 /\ Incid e x1).
split.
assumption.
assumption.
assert( HH3 : Incid a x2 /\ Incid c x2).
split.
assumption.
assumption.
assert( HH4 : Incid d x3 /\ Incid e x3).
split.
assumption.
assumption.
assert( HH5 : exists I : Point, (Incid I x /\ Incid I x1)).
exists x4.
split.
assumption.
assumption.
assert( HH6 := a2 a d c e x x1 x2 x3 HH0 HH1 HH2 HH3 HH4 HH5).
destruct HH6.
destruct H22.
assert( HH7 : Intersect x2 x3).
unfold Intersect.
exists x6.
split.
assumption.
assumption.
contradiction.
intros.
(* Cas non degenere *)
assert( HH0 : dist4 x5 d x4 e).
unfold dist4.
split.
assumption.
split.
intro.
clear H3.
rewrite H8 in *.
apply n8.
reflexivity.
split.
assumption.
split.
intro.
clear H4.
rewrite H8 in *.
apply n9.
reflexivity.
split.
assumption.
assumption.
destruct a0.
destruct a1.
destruct a2.
destruct a3.
destruct a4.
destruct H1.
destruct H2.
assert( HH1 : Incid x5 x0 /\ Incid d x0).
split.
assumption.
assumption.
assert( HH2 : Incid x4 x1 /\ Incid e x1).
split.
assumption.
assumption.
assert( HH3 : Incid x5 x /\ Incid x4 x).
split.
assumption.
assumption.
assert( HH4 : Incid d x3 /\ Incid e x3).
split.
assumption.
assumption.
assert( HH5 : exists I : Point, (Incid I x0 /\ Incid I x1)).
exists c.
split.
assumption.
assumption.
assert( HH6 := a2 x5 d x4 e x0 x1 x x3 HH0 HH1 HH2 HH3 HH4 HH5).
destruct HH6.
(* Pasch 2 *)
assert( HH6 := a1_exist a d).
destruct HH6.
case_eq (eq_dec_u a d).
intros.
rewrite e0 in *.
assert( HH7 : Intersect x2 x3).
unfold Intersect.
exists d.
split.
assumption.
assumption.
contradiction.
intros.
case_eq (eq_dec_u a e).
intros.
rewrite e0 in *.
assert( HH7 : Intersect x2 x3).
unfold Intersect.
exists e.
split.
assumption.
assumption.
contradiction.
intros.
case_eq (eq_dec_u a x4).
intros.
rewrite <-e0 in *.
assert( HH7 := uniqueness a c x1 x2 H18 H12 H14 H15).
destruct HH7.
contradiction.
rewrite H24 in *.
assert( HH7 : Intersect x2 x3).
unfold Intersect.
exists e.
split.
assumption.
assumption.
contradiction.
intros.
assert( HH7 : dist4 a x4 d e).
unfold dist4.
split.
assumption.
split.
assumption.
split.
assumption.
split.
assumption.
split.
assumption.
assumption.
destruct a0.
assert( HH8 : Incid a x7 /\ Incid d x7).
split.
assumption.
assumption.
assert( HH9 : Incid x4 x1 /\ Incid e x1).
split.
assumption.
assumption.
assert( HH10 : Incid a x /\ Incid x4 x).
split.
assumption.
assumption.
assert( HH11 : Incid d x3 /\ Incid e x3).
split.
assumption.
assumption.
assert( HH12 : exists I : Point, (Incid I x /\ Incid I x3)).
exists x6.
destruct H20.
split.
assumption.
assumption.
assert( HH13 := a2 a x4 d e x x3 x7 x1 HH7 HH10 HH11 HH8 HH9 HH12).
destruct HH13.
(* Pasch 3 *)
assert( HH14 : dist4 a d c e).
unfold dist4.
split.
assumption.
split.
assumption.
split.
assumption.
split.
intro.
rewrite H27 in *.
apply n6.
reflexivity.
split.
assumption.
assumption.
assert( HH15 : Incid a x7 /\ Incid d x7).
split.
assumption.
assumption.
assert( HH16 : Incid c x1 /\ Incid e x1).
split.
assumption.
assumption.
assert( HH17 : Incid a x2 /\ Incid c x2).
split.
assumption.
assumption.
assert( HH18 : Incid d x3 /\ Incid e x3).
split.
assumption.
assumption.
assert( HH19 : exists I : Point, (Incid I x7 /\ Incid I x1)).
exists x8.
destruct H26.
split.
assumption.
assumption.
assert( HH20 := a2 a d c e x7 x1 x2 x3 HH14 HH15 HH16 HH17 HH18 HH19).
destruct HH20.
destruct H27.
assert( HH21 : Intersect x2 x3).
unfold Intersect.
exists x9.
split.
assumption.
assumption.
contradiction.
intros.
inversion H8.
intros.
inversion H4.
Qed.

Lemma cop_trans_bis_bis : forall a b c d e, collinear a b c = false -> coplanar a b c d = true -> coplanar a b c e = true -> coplanar b c d e = true.
Proof.
unfold coplanar.
intros a b c d e H.
case_eq (eq_dec_u a b).
case_eq (eq_dec_u b c).
intros.
reflexivity.
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist b c).
simpl.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x x0).
intros.
reflexivity.
case_eq (eq_dec_p x x0).
intros.
reflexivity.
intros.
clear H0 H1 H2 H3 H4 H5 H6.
rewrite e0 in *.
assert( HH0 := col_1 b c).
rewrite HH0 in H.
inversion H.
case_eq (eq_dec_u c d).
case_eq (eq_dec_u c e).
case_eq (eq_dec_u b c).
intros.
reflexivity.
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist b c).
simpl.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x x0).
intros.
reflexivity.
case_eq (eq_dec_p x x0).
intros.
reflexivity.
intros.
clear H0 H1 H2 H3 H4 H5 H6 H7 H8.
rewrite e0 in *.
rewrite e1 in *.
assert( HH0 : Intersect x x0).
unfold Intersect.
exists d.
destruct a0.
destruct a1.
split.
assumption.
assumption.
contradiction.
destruct (a1_exist a b).
simpl.
destruct (a1_exist c e).
simpl.
case_eq (eq_dec_l x x0).
case_eq (eq_dec_u b c).
intros.
reflexivity.
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist b c).
simpl.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x1 x2).
intros.
reflexivity.
intros.
case_eq (eq_dec_p x1 x2).
intros.
reflexivity.
intros.
clear H0 H1 H2 H3 H4 H5 H6 H7 H8 H9.
rewrite e1 in *.
assert( HH0 : Intersect x1 x2).
unfold Intersect.
exists d.
destruct a2.
destruct a3.
split.
assumption.
assumption.
contradiction.
case_eq (eq_dec_p x x0).
case_eq (eq_dec_u b c).
intros.
reflexivity.
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist b c).
simpl.
destruct (a1_exist d e).
simpl.
destruct (eq_dec_l x1 x2).
intros.
reflexivity.
case_eq (eq_dec_p x1 x2).
intros.
reflexivity.
intros.
clear H0 H1 H2 H3 H4 H5 H6 H7 H8 H9.
rewrite e0 in *.
assert( HH0 : Intersect x1 x2).
unfold Intersect.
exists d.
destruct a2.
destruct a3.
split.
assumption.
assumption.
contradiction.
intros.
inversion H6.
destruct (a1_exist a b).
simpl.
destruct (a1_exist c d).
simpl.
case_eq (eq_dec_l x x0).
simpl.
case_eq (eq_dec_u c e).
case_eq (eq_dec_u d e).
case_eq (eq_dec_u b c).
intros.
reflexivity.
intros.
reflexivity.
case_eq (eq_dec_u b c).
intros.
reflexivity.
destruct (a1_exist b c).
simpl.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x1 x2).
intros.
reflexivity.
case_eq (eq_dec_p x1 x2).
intros.
reflexivity.
intros.
clear H0 H1 H2 H3 H4 H5 H6 H7 H8 H9.
rewrite e0 in *.
rewrite e1 in *.
assert( HH0 : Intersect x1 x2).
unfold Intersect.
exists e.
destruct a2.
destruct a3.
split.
assumption.
assumption.
contradiction.
destruct (a1_exist c e).
simpl.
case_eq (eq_dec_l x x1).
case_eq (eq_dec_u b c).
intros.
reflexivity.
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist b c).
simpl.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x2 x3).
intros.
reflexivity.
case_eq (eq_dec_p x2 x3).
intros.
reflexivity.
intros.
clear H0 H1 H2 H3 H4 H5 H6 H7 H8 H9 H10.
rewrite e0 in *.
rewrite e1 in *.
destruct a0.
destruct a1.
destruct a3.
assert( HH0 := uniqueness b c x0 x2 H1 H2 H4 H5).
destruct HH0.
contradiction.
rewrite H6 in *.
assert( HH0 : Intersect x2 x3).
unfold Intersect.
exists d.
destruct a4.
split.
assumption.
assumption.
contradiction.
case_eq (eq_dec_p x x1).
case_eq (eq_dec_u b c).
intros.
reflexivity.
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist b c).
simpl.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x2 x3).
intros.
reflexivity.
case_eq (eq_dec_p x2 x3).
intros.
reflexivity.
intros.
clear H0 H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11.
rewrite e0 in *.
destruct a0.
destruct a1.
destruct a3.
assert( HH0 := uniqueness b c x0 x2 H1 H2 H4 H5).
destruct HH0.
contradiction.
rewrite H6 in *.
assert( HH0 : Intersect x2 x3).
unfold Intersect.
exists d.
destruct a4.
split.
assumption.
assumption.
contradiction.
intros.
inversion H7.
case_eq (eq_dec_p x x0).
case_eq (eq_dec_u c e).
case_eq (eq_dec_u b c).
intros.
reflexivity.
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist b c).
simpl.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x1 x2).
intros.
reflexivity.
case_eq (eq_dec_p x1 x2).
intros.
reflexivity.
intros.
clear H0 H1 H2 H3 H4 H5 H6 H7 H8 H9 H10.
rewrite e0 in *.
assert( HH0 : Intersect x1 x2).
unfold Intersect.
exists e.
destruct a2.
destruct a3.
split.
assumption.
assumption.
contradiction.
destruct (a1_exist c e).
simpl.
case_eq (eq_dec_l x x1).
case_eq (eq_dec_u b c).
intros.
reflexivity.
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist b c).
simpl.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x2 x3).
intros.
reflexivity.
case_eq (eq_dec_p x2 x3).
intros.
reflexivity.
intros.
clear H0 H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11.
rewrite e0 in *.
destruct a0.
destruct a2.
destruct a3.
assert( HH0 := uniqueness b c x1 x2 H1 H2 H4 H5).
destruct HH0.
contradiction.
rewrite H6 in *.
assert( HH0 : Intersect x2 x3).
unfold Intersect.
exists e.
destruct a4.
split.
assumption.
assumption.
contradiction.
case_eq (eq_dec_p x x1).
case_eq (eq_dec_u b c).
intros.
reflexivity.
case_eq (eq_dec_u d e).
intros.
reflexivity.
destruct (a1_exist b c).
simpl.
destruct (a1_exist d e).
simpl.
case_eq (eq_dec_l x2 x3).
intros.
reflexivity.
case_eq (eq_dec_p x2 x3).
intros.
reflexivity.
intros.
clear H0 H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11 H12.
(* Triple Pasch *)
(* Pasch 1 *)
unfold Intersect in i.
destruct i.
unfold Intersect in i0.
destruct i0.
destruct a0.
destruct a1.
destruct a2.
destruct a3.
destruct a4.
destruct H0.
destruct H1.
case_eq (eq_dec_u x5 e).
intros.
rewrite e0 in *.
assert( HH0 := uniqueness c e x0 x1 H4 H13 H6 H7).
destruct HH0.
contradiction.
rewrite H15 in *.
assert( HH0 := uniqueness d e x1 x3 H5 H7 H10 H11).
destruct HH0.
contradiction.
rewrite H16 in *.
assert( HH0 : Intersect x2 x3).
unfold Intersect.
exists c.
split.
assumption.
assumption.
contradiction.
intros.
case_eq (eq_dec_u x4 d).
intros.
rewrite e0 in *.
assert( HH0 := uniqueness c d x0 x1 H4 H5 H6 H12).
destruct HH0.
rewrite H16 in *.
assert( HH0 := uniqueness d e x1 x3 H6 H7 H10 H11).
destruct HH0.
contradiction.
rewrite H17 in *.
assert( HH0 : Intersect x2 x3).
unfold Intersect.
exists d.
split.
assumption.
assumption.
contradiction.
rewrite H16 in *.
assert( HH0 := uniqueness d e x1 x3 H5 H7 H10 H11).
destruct HH0.
contradiction.
rewrite H17 in *.
assert( HH0 : Intersect x2 x3).
unfold Intersect.
exists c.
split.
assumption.
assumption.
contradiction.
intros.
case_eq (eq_dec_u x4 x5).
intros.
clear H14 H15 H16.
rewrite e0 in *.
assert( HH0 := uniqueness c x5 x0 x1 H4 H13 H6 H12).
destruct HH0.
rewrite <-H14 in *.
assert( HH0 := uniqueness b c x x2 H3 H0 H8 H9).
destruct HH0.
contradiction.
rewrite H15 in *.
assert( HH0 : collinear a b c = true).
unfold collinear.
case_eq (eq_dec_u a b).
intros.
reflexivity.
intros.
destruct (a1_exist a b).
simpl.
case_eq (incid_dec c x6).
intros.
reflexivity.
intros.
destruct a0.
assert( HH0 := uniqueness a b x2 x6 H2 H3 H18 H19).
destruct HH0.
contradiction.
rewrite H20 in *.
contradiction.
rewrite HH0 in H.
inversion H.
rewrite H14 in *.
assert( HH0 := uniqueness d e x1 x3 H5 H7 H10 H11).
destruct HH0.
contradiction.
rewrite H15 in *.
assert( HH0 : Intersect x2 x3).
unfold Intersect.
exists c.
split.
assumption.
assumption.
contradiction.
intros.
(* Cas degenere x4 = e *)
case_eq (eq_dec_u x4 e).
intros.
clear H14 H15 H16 H17.
rewrite e0 in *.
case_eq (eq_dec_u x5 d).
intros.
rewrite e1 in *.
assert( HH0 := uniqueness d e x x3 H1 H0 H10 H11).
destruct HH0.
contradiction.
rewrite H15 in *.
assert( HH0 : Intersect x2 x3).
unfold Intersect.
exists b.
split.
assumption.
assumption.
contradiction.
intros.
case_eq (eq_dec_u b d).
intros.
rewrite e1 in *.
assert( HH0 : Intersect x2 x3).
unfold Intersect.
exists d.
split.
assumption.
assumption.
contradiction.
intros.
case_eq (eq_dec_u b e).
intros.
rewrite e1 in *.
assert( HH0 : Intersect x2 x3).
unfold Intersect.
exists e.
split.
assumption.
assumption.
contradiction.
intros.
assert( HH0 : dist4 b e c d).
unfold dist4.
split.
assumption.
split.
assumption.
split.
assumption.
split.
intro.
rewrite H17 in *.
apply n4.
reflexivity.
split.
assumption.
assumption.
assert( HH1 : Incid b x /\ Incid e x).
split.
assumption.
assumption.
assert( HH2 : Incid c x0 /\ Incid d x0).
split.
assumption.
assumption.
assert( HH3 : Incid b x2 /\ Incid c x2).
split.
assumption.
assumption.
assert( HH4 : Incid e x3 /\ Incid d x3).
split.
assumption.
assumption.
assert( HH5 : exists I : Point, Incid I x /\ Incid I x0).
exists x5.
split.
assumption.
assumption.
assert( HH6 := a2 b e c d x x0 x2 x3 HH0 HH1 HH2 HH3 HH4 HH5).
destruct HH6.
assert( HH7 : Intersect x2 x3).
unfold Intersect.
destruct H17.
exists x6.
split.
assumption.
assumption.
contradiction.
intros.
(* Cas degenere  x5 = d *)
case_eq (eq_dec_u x5 d).
intros.
case_eq (eq_dec_u b d).
intros.
rewrite e1 in *.
assert( HH0 : Intersect x2 x3).
unfold Intersect.
exists d.
split.
assumption.
assumption.
contradiction.
intros.
case_eq (eq_dec_u b e).
intros.
rewrite e1 in *.
assert( HH0 : Intersect x2 x3).
unfold Intersect.
exists e.
split.
assumption.
assumption.
contradiction.
intros.
rewrite e0 in *.
assert( HH0 : dist4 d b e c).
unfold dist4.
split.
intro.
clear H19.
rewrite H21 in *.
apply n12.
reflexivity.
split.
assumption.
split.
intro.
rewrite H21 in *.
apply n6.
reflexivity.
split.
assumption.
split.
assumption.
intro.
rewrite H21 in *.
apply n4.
reflexivity.
assert( HH1 : Incid d x /\ Incid b x).
split.
assumption.
assumption.
assert( HH2 : Incid e x1 /\ Incid c x1).
split.
assumption.
assumption.
assert( HH3 : Incid d x3 /\ Incid e x3).
split.
assumption.
assumption.
assert( HH4 : Incid b x2 /\ Incid c x2).
split.
assumption.
assumption.
assert( HH5 : exists I : Point, Incid I x /\ Incid I x1).
exists x4.
split.
assumption.
assumption.
assert( HH6 := a2 d b e c x x1 x3 x2 HH0 HH1 HH2 HH3 HH4 HH5).
destruct HH6.
destruct H21.
assert( HH7 : Intersect x2 x3).
unfold Intersect.
exists x6.
split.
assumption.
assumption.
contradiction.
intros.
(* Cas non degenere *)
assert( HH0 : dist4 x5 d x4 e).
unfold dist4.
split.
assumption.
split.
intro.
clear H16.
rewrite H19 in n10.
apply n10.
reflexivity.
split.
assumption.
split.
intro.
clear H15.
rewrite H19 in *.
apply n9.
reflexivity.
split.
assumption.
assumption.
assert( HH1 : Incid x5 x0 /\ Incid d x0).
split.
assumption.
assumption.
assert( HH2 : Incid x4 x1 /\ Incid e x1).
split.
assumption.
assumption.
assert( HH3 : Incid x5 x /\ Incid x4 x).
split.
assumption.
assumption.
assert( HH4 : Incid d x3 /\ Incid e x3).
split.
assumption.
assumption.
assert( HH5 : exists I : Point, Incid I x0 /\ Incid I x1).
exists c.
split.
assumption.
assumption.
assert( HH6 := a2 x5 d x4 e x0 x1 x x3 HH0 HH1 HH2 HH3 HH4 HH5).
destruct HH6.
destruct H19.
assert( HH7 := a1_exist b d).
destruct HH7.
case_eq (eq_dec_u b x4).
intros.
rewrite <-e0 in *.
assert( HH8 := uniqueness b c x1 x2 H12 H6 H8 H9).
destruct HH8.
contradiction.
rewrite H22 in *.
assert( HH8 : Intersect x2 x3).
unfold Intersect.
exists e.
split.
assumption.
assumption.
contradiction.
intros.
case_eq (eq_dec_u b d).
intros.
rewrite e0 in *.
assert( HH8 : Intersect x2 x3).
unfold Intersect.
exists d.
split.
assumption.
assumption.
contradiction.
intros.
case_eq (eq_dec_u b e).
intros.
rewrite e0 in *.
assert( HH8 : Intersect x2 x3).
unfold Intersect.
exists e.
split.
assumption.
assumption.
contradiction.
(* Pasch 2 *)
intros.
assert( HH8 : dist4 b x4 d e).
unfold dist4.
split.
assumption.
split.
assumption.
split.
assumption.
split.
assumption.
split.
assumption.
assumption.
destruct a0.
assert( HH9 : Incid b x /\ Incid x4 x).
split.
assumption.
assumption.
assert( HH10 : Incid d x3 /\ Incid e x3).
split.
assumption.
assumption.
assert( HH11 : Incid b x7 /\ Incid d x7).
split.
assumption.
assumption.
assert( HH12 : Incid x4 x1 /\ Incid e x1).
split.
assumption.
assumption.
assert( HH13 : exists I : Point, Incid I x /\ Incid I x3).
exists x6.
split.
assumption.
assumption.
assert( HH14 := a2 b x4 d e x x3 x7 x1 HH8 HH9 HH10 HH11 HH12 HH13).
destruct HH14.
destruct H26.
(* Pasch 3 *)
assert( HH15 : dist4 b d c e).
unfold dist4.
split.
assumption.
split.
assumption.
split.
assumption.
split.
intro.
rewrite H28 in *.
apply n6.
reflexivity.
split.
assumption.
assumption.
assert( HH16 : Incid b x7 /\ Incid d x7).
split.
assumption.
assumption.
assert( HH17 : Incid c x1 /\ Incid e x1).
split.
assumption.
assumption.
assert( HH18 : Incid b x2 /\ Incid c x2).
split.
assumption.
assumption.
assert( HH19 : Incid d x3 /\ Incid e x3).
split.
assumption.
assumption.
assert( HH20 : exists I : Point, Incid I x7 /\ Incid I x1).
exists x8.
split.
assumption.
assumption.
assert( HH21 := a2 b d c e x7 x1 x2 x3 HH15 HH16 HH17 HH18 HH19 HH20).
destruct HH21.
destruct H28.
assert( HH22 : Intersect x2 x3).
unfold Intersect.
exists x9.
split.
assumption.
assumption.
contradiction.
intros.
inversion H8.
intros.
inversion H4.
Qed.

Lemma col_to_cop :
forall x x0 x1 x2,
collinear x x0 x1 = true -> coplanar x x0 x1 x2 = true.
Proof.
intros.
generalize H.
unfold coplanar.
intros.
case_eq (eq_dec_u x x0).
intros.
reflexivity.
intros.
case_eq (eq_dec_u x1 x2).
intros.
reflexivity.
intros.
destruct (a1_exist x x0).
destruct (a1_exist x1 x2).
simpl.
case_eq (eq_dec_l x3 x4).
intros.
reflexivity.
intros.
case_eq (eq_dec_p x3 x4).
intros.
reflexivity.
intros.
generalize H.
unfold collinear.
case_eq (eq_dec_u x x0).
intros.
contradiction.
destruct (a1_exist x x0).
simpl.
case_eq (incid_dec x1 x5).
intros.
destruct a.
destruct a1.
assert (HH0 := uniqueness x x0 x3 x5 H8 H9 H10 H11).
destruct HH0.
contradiction.
clear H5.
rewrite <-H12 in *.
assert( HH0 : Intersect x3 x4).
unfold Intersect.
exists x1.
split.
assumption.
destruct a0.
assumption.
contradiction.
intros.
inversion H7.
Qed.

Global Instance coplanar_morph : Proper (eq ==> eq ==> eq ==> eq ==> Logic.eq) coplanar.
Proof.
repeat red.
intros; subst.
unfold coplanar.
case_eq(eq_dec_u y y0).
reflexivity.
case_eq(eq_dec_u y1 y2).
reflexivity.
intros.

destruct(a1_exist y y0).
destruct(a1_exist y1 y2).
simpl.
reflexivity.
Qed.

End s_psohEquivCop.

Ltac my_cop2 :=
  repeat match goal with
  |[H : coplanar ?W ?X ?Y ?Z = true |- coplanar ?W ?X ?Y ?Z = true] => solve[intuition]
  |[H : coplanar ?W ?X ?Z ?Y = true |- coplanar ?W ?X ?Y ?Z = true] => rewrite cop_exchange2;solve[intuition]
  |[H : coplanar ?W ?Y ?X ?Z = true |- coplanar ?W ?X ?Y ?Z = true] => rewrite cop_exchange3;solve[intuition]
  |[H : coplanar ?W ?Y ?Z ?X = true |- coplanar ?W ?X ?Y ?Z = true] => rewrite cop_exchange3;rewrite cop_exchange2;solve[intuition]
  |[H : coplanar ?W ?Z ?X ?Y = true |- coplanar ?W ?X ?Y ?Z = true] => rewrite cop_exchange2;rewrite cop_exchange3;solve[intuition]
  |[H : coplanar ?W ?Z ?Y ?X = true |- coplanar ?W ?X ?Y ?Z = true] => rewrite cop_exchange2;rewrite cop_exchange3;rewrite cop_exchange2;solve[intuition]
  |[H : coplanar ?X ?W ?Y ?Z = true |- coplanar ?W ?X ?Y ?Z = true] => rewrite cop_exchange1;solve[intuition]
  |[H : coplanar ?X ?W ?Z ?Y = true |- coplanar ?W ?X ?Y ?Z = true] => rewrite cop_exchange1;rewrite cop_exchange2;solve[intuition]
  |[H : coplanar ?X ?Y ?W ?Z = true |- coplanar ?W ?X ?Y ?Z = true] => rewrite cop_exchange1;rewrite cop_exchange3;solve[intuition]
  |[H : coplanar ?X ?Y ?Z ?W = true |- coplanar ?W ?X ?Y ?Z = true] => rewrite cop_exchange1;rewrite cop_exchange3;rewrite cop_exchange2;solve[intuition]
  |[H : coplanar ?X ?Z ?W ?Y = true |- coplanar ?W ?X ?Y ?Z = true] => rewrite cop_exchange1;rewrite cop_exchange2;rewrite cop_exchange3;solve[intuition]
  |[H : coplanar ?X ?Z ?Y ?W = true |- coplanar ?W ?X ?Y ?Z = true] => rewrite cop_exchange1;rewrite cop_exchange3;rewrite cop_exchange2;rewrite cop_exchange3;solve[intuition]
  |[H : coplanar ?Y ?W ?X ?Z = true |- coplanar ?W ?X ?Y ?Z = true] => rewrite cop_exchange3;rewrite cop_exchange1;solve[intuition]
  |[H : coplanar ?Y ?W ?Z ?X = true |- coplanar ?W ?X ?Y ?Z = true] => rewrite cop_exchange3;rewrite cop_exchange1;rewrite cop_exchange2;solve[intuition]
  |[H : coplanar ?Y ?X ?W ?Z = true |- coplanar ?W ?X ?Y ?Z = true] => rewrite cop_exchange3;rewrite cop_exchange1;rewrite cop_exchange3;solve[intuition]
  |[H : coplanar ?Y ?X ?Z ?W = true |- coplanar ?W ?X ?Y ?Z = true] => rewrite cop_exchange3;rewrite cop_exchange1;rewrite cop_exchange3;rewrite cop_exchange2;solve[intuition]
  |[H : coplanar ?Y ?Z ?W ?X = true |- coplanar ?W ?X ?Y ?Z = true] => rewrite cop_exchange3;rewrite cop_exchange1;rewrite cop_exchange2;rewrite cop_exchange3;solve[intuition]
  |[H : coplanar ?Y ?Z ?X ?W = true |- coplanar ?W ?X ?Y ?Z = true] => rewrite cop_exchange3;rewrite cop_exchange1;rewrite cop_exchange2;rewrite cop_exchange3;rewrite cop_exchange2;solve[intuition]
  |[H : coplanar ?Z ?W ?X ?Y = true |- coplanar ?W ?X ?Y ?Z = true] => rewrite cop_exchange2;rewrite cop_exchange3;rewrite cop_exchange1;solve[intuition]
  |[H : coplanar ?Z ?W ?Y ?X = true |- coplanar ?W ?X ?Y ?Z = true] => rewrite cop_exchange2;rewrite cop_exchange3;rewrite cop_exchange1;rewrite cop_exchange2;solve[intuition]
  |[H : coplanar ?Z ?X ?W ?Y = true |- coplanar ?W ?X ?Y ?Z = true] => rewrite cop_exchange2;rewrite cop_exchange1;rewrite cop_exchange3;rewrite cop_exchange1;solve[intuition]
  |[H : coplanar ?Z ?X ?Y ?W = true |- coplanar ?W ?X ?Y ?Z = true] => rewrite cop_exchange2;rewrite cop_exchange3;rewrite cop_exchange1;rewrite cop_exchange3;rewrite cop_exchange2;solve[intuition]
  |[H : coplanar ?Z ?Y ?W ?X = true |- coplanar ?W ?X ?Y ?Z = true] => rewrite cop_exchange2;rewrite cop_exchange3;rewrite cop_exchange1;rewrite cop_exchange2;rewrite cop_exchange3;solve[intuition]
  |[H : coplanar ?Z ?Y ?X ?W = true |- coplanar ?W ?X ?Y ?Z = true] => rewrite cop_exchange2;rewrite cop_exchange3;rewrite cop_exchange1;rewrite cop_exchange3;rewrite cop_exchange2;rewrite cop_exchange3;solve[intuition]
end.