Require Import HoTT.
Require Import HitTactics.
Require Import definition.
Require Import operations.
Require Import properties.
Require Import empty_set.
Class Antisymmetric {A} (R : relation A) :=
  antisymmetry : forall x y, R x y -> R y x -> x = y.
  
  
Class Total {A} (R : relation A) :=
  total : forall x y,  x = y \/ R x y \/ R y x. 
  
Class TotalOrder {A} (R : relation A) :=
  { TotalOrder_Reflexive : Reflexive R | 2 ;
    TotalOrder_Antisymmetric : Antisymmetric R | 2; 
    TotalOrder_Transitive : Transitive R | 2;
    TotalOrder_Total : Total R | 2; }. 

Context {A : Type0}.
Context {A_deceq : DecidablePaths A}.
Context {R: relation A}.
Context {A_ordered : TotalOrder R}.


Ltac eq_neq_tac :=
match goal  with
    |  [ H: ?x <> E, H': ?x = E |- _ ] => destruct H; assumption
end.


Ltac destruct_match_1 :=
	repeat match goal with
    | [|- match ?X with | _ => _ end ] => destruct X
    | [|- ?X = ?Y ] => apply path_ishprop
    | [ H: ?x <> E  |- Empty ] => destruct H
    | [  H1: ?x = E, H2: ?y = E, H3: ?w ∪ ?q  = E |- ?r = E]
    			=> rewrite H1, H2 in H3; rewrite nl in H3;  rewrite nl in H3
  end.
			

Lemma transport_dom_eq (D1 D2 C: Type) (P: D1 = D2) (f: D1 -> C) : 
transport (fun T: Type => T -> C) P f = fun y => f (transport (fun X => X) P^ y).
Proof.
induction P.
hott_simpl.
Defined.

Lemma transport_dom_eq_gen (Ty: Type) (D1 D2: Ty) (C: Type) (P: D1 = D2) 
			(Q : Ty -> Type) (f: Q D1 -> C) : 
transport (fun X: Ty => Q X -> C) P f = fun y => f (transport Q P^ y).
Proof.
induction P.
hott_simpl.
Defined.
			
(* Lemma min {HFun: Funext} (x: FSet A): x <> ∅  -> A. *)
(* Proof. *)
(* hrecursion x.  *)
(* - intro H. destruct H. reflexivity. *)
(* - intros. exact a. *)
(* - intros x y rx ry H. *)
(* 	apply union_non_empty' in H. *)
(* 	destruct H.  *)
(* 	+ destruct p. specialize (rx fst). exact rx. *)
(* 	+ destruct s.  *)
(* 		* destruct p. specialize (ry snd). exact ry. *)
(* 		* destruct p.  specialize (rx fst). specialize (ry snd). *)
(* 			destruct (TotalOrder_Total rx ry) as [Heq | [ Hx | Hy ]]. *)
(* 			** exact rx. *)
(* 			** exact rx. *)
(* 			** exact ry. *)
(* - intros. rewrite transport_dom_eq_gen. *)
(* 	apply path_forall. intro y0.  *)
(* 	destruct (  union_non_empty' x y ∪ z  *)
(* 	(transport (fun X : FSet A => X <> ∅) (assoc x y z)^ y0)) *)
(* 	as [[ G1 G2] | [[ G3 G4] | [G5 G6]]]. *)
(* 	+ pose (G2' := G2). apply  eset_union_lr in G2'; destruct G2'. cbn. *)
(* 		destruct (union_non_empty' x ∪ y z y0) as  *)
(* 	 [[H'x H'y] | [ [H'a H'b] | [H'c H'd]]]; try eq_neq_tac. *)
(* 	 destruct (union_non_empty' x y H'x).  *)
(* 	 	** destruct p. assert (G1 = fst0).  apply path_forall. intro. *)
(* 		 apply path_ishprop. rewrite X. reflexivity.  *)
(* 	 	** destruct s; destruct p; eq_neq_tac.  *)
(* 	+ destruct (union_non_empty' y z G4)  as  *)
(* 	[[H'x H'y] | [ [H'a H'b] | [H'c H'd]]]; try eq_neq_tac. *)
(* 	destruct (union_non_empty' x ∪ y z y0). *)
(* 		** destruct p. cbn. destruct (union_non_empty' x y fst). *)
(* 			*** destruct p; eq_neq_tac. *)
(* 			*** destruct s. destruct p. *)
(* 				**** assert (H'x = snd0).  apply path_forall. intro. *)
(* 		 apply path_ishprop. rewrite X. reflexivity. *)
(* 		 	  **** destruct p. eq_neq_tac. *)
(* 		** destruct s; destruct p; try eq_neq_tac. *)
(* 		** destruct (union_non_empty' x ∪ y z y0). *)
(* 			*** destruct p. eq_neq_tac. *)
(* 			*** destruct s. destruct p. *)
(* 				**** assert (H'b = snd).  apply path_forall. intro. *)
(* 		 			apply path_ishprop. rewrite X. reflexivity. *)
(* 		 		**** destruct p. assert (x ∪ y = E). *)
(* 		 		rewrite H'a, G3. apply union_idem.  eq_neq_tac.  *)
(* 		** cbn. destruct (TotalOrder_Total (py H'c) (pz H'd)). *)
(* 			*** destruct (union_non_empty' x ∪ y z y0). *)
(* 				**** destruct p0. eq_neq_tac. *)
(* 				**** destruct s. *)
(* 					*****  destruct p0. rewrite G3, nl in fst. eq_neq_tac. *)
(* 					*****  destruct p0. destruct (union_non_empty' x y fst). *)
(* 						****** destruct p0. eq_neq_tac. *)
(* 						****** destruct s.  *)
(* 						 ******* destruct p0.  *)
(* 						 				destruct (TotalOrder_Total (py snd0) (pz snd)). *)
(* 						 				f_ap. apply path_forall. intro. *)
(* 		 								apply path_ishprop.  *)
(* 		 								destruct s. f_ap. apply path_forall. intro. *)
(* 		 								apply path_ishprop. *)
(* 		 								rewrite p. f_ap. apply path_forall. intro. *)
(* 		 								apply path_ishprop.  *)
(* 		 				******* destruct p0. eq_neq_tac. *)
(* 		 	*** destruct (union_non_empty' x ∪ y z y0). *)
(* 		 		**** destruct p. eq_neq_tac. *)
(* 		 		**** destruct s0. destruct p. rewrite comm in fst. *)
(* 		 				 apply eset_union_l in fst. eq_neq_tac. *)
(* 		 				 destruct p.  *)
(* 		 				 destruct (union_non_empty' x y fst). *)
(* 		 				 ***** destruct p; eq_neq_tac. *)
(* 		 				 ***** destruct s0. destruct p.  *)
(* 		 				 		destruct (TotalOrder_Total (py snd0) (pz snd)); *)
(* 		 				 		destruct s; try (f_ap;  apply path_forall; intro; *)
(* 		 														 apply path_ishprop). *)
(* 		 						rewrite p. f_ap;  apply path_forall; intro; *)
(* 		 														 apply path_ishprop. *)
(* 		 						destruct s0. 		f_ap;  apply path_forall; intro; *)
(* 		 														 apply path_ishprop. *)
(* 		 						assert (snd0 = H'c).   apply path_forall; intro; *)
(* 		 														 apply path_ishprop. *)
(* 		 						assert (snd = H'd).   apply path_forall; intro; *)
(* 		 														 apply path_ishprop. *)
(* 		 						rewrite <- X0 in r. rewrite X in r0. *)
(* 		 						apply TotalOrder_Antisymmetric; assumption. *)
(* 		 						destruct s0.				 *)
(* 		 						assert (snd0 = H'c).   apply path_forall; intro; *)
(* 		 														 apply path_ishprop. *)
(* 		 						assert (snd = H'd).   apply path_forall; intro; *)
(* 		 														 apply path_ishprop. *)
(* 		 						rewrite <- X in r. rewrite X0 in r0. *)
(* 		 						apply TotalOrder_Antisymmetric; assumption. *)
(* 		 						f_ap;  apply path_forall; intro; *)
(* 		 														 apply path_ishprop. *)
(* 		 						destruct p; eq_neq_tac. *)
(* 	+ cbn. destruct (union_non_empty' y z G6). *)
(* 		** destruct p. destruct ( union_non_empty' x ∪ y z y0). *)
(* 			*** destruct p. destruct (union_non_empty' x y fst0). *)
(* 				**** destruct p; eq_neq_tac. *)
(* 				**** destruct s; destruct p. eq_neq_tac.		 *)
(* 						assert (fst1 = G5).   apply path_forall; intro; *)
(* 		 														 apply path_ishprop. *)
(* 		 				assert (fst = snd1).   apply path_forall; intro; *)
(* 		 														 apply path_ishprop. *)
(* 		 				rewrite X, X0.			 *)
(* 		 			  destruct (TotalOrder_Total (px G5) (py snd1)). *)
(* 		 			  reflexivity. *)
(* 		 			  destruct s; reflexivity. *)
(* 		 	*** destruct s; destruct p; eq_neq_tac.  *)
(* 		** destruct (union_non_empty' x ∪ y z y0).  *)
(* 			*** destruct p. destruct s; destruct p; eq_neq_tac. *)
(* 			*** destruct s. destruct p. destruct s0. destruct p. *)
(* 					apply eset_union_l in fst0. eq_neq_tac. *)
(* 				**** destruct p. 		 *)
(* 		 					assert (snd = snd0).   apply path_forall; intro; *)
(* 		 														 apply path_ishprop.		  *)
				
(* 				destruct (union_non_empty' x y fst0).  *)
(* 				destruct p. *)
(* 				 assert (fst1 = G5).  apply path_forall; intro; *)
(* 		 														 apply path_ishprop.  *)
(* 		 				assert (fst = snd1).  apply set_path2. *)
(* 					***** rewrite X0. rewrite <- X. reflexivity. *)
(* 					*****  destruct s; destruct p; eq_neq_tac. *)
(* 				**** destruct s0. destruct p0. destruct p.  *)
(* 					***** apply eset_union_l in fst. eq_neq_tac. *)
(* 					***** destruct p, p0. *)
(* 					assert (snd0 = snd).   apply path_forall; intro; *)
(* 		 														 apply path_ishprop. *)
(* 		 			rewrite X.												 *)
(* 					 destruct (union_non_empty' x y fst0). *)
(* 					 destruct p; eq_neq_tac. *)
(* 					 destruct s. destruct p; eq_neq_tac. *)
(* 					 destruct p. *)
(* 					 assert (fst = snd1).   apply path_forall; intro; *)
(* 		 														 apply path_ishprop. *)
(* 						assert (fst1 = G5).   apply path_forall; intro; *)
(* 		 														 apply path_ishprop.								  *)
(* 						rewrite <- X0. rewrite X1. 											 *)
(* 					  destruct (TotalOrder_Total (py fst) (pz snd)). *)
(* 					  ****** rewrite <- p.  *)
(* 					   destruct (TotalOrder_Total (px G5) (py fst)). *)
(* 					   rewrite <- p0.  *)
(* 					 		destruct (TotalOrder_Total (px G5) (px G5)). *)
(* 					 		reflexivity. *)
(* 					 		destruct s; reflexivity. *)
(* 					 		destruct s. destruct (TotalOrder_Total (px G5) (py fst)). *)
(* 					 		reflexivity. *)
(* 					 		destruct s. *)
(* 					 		reflexivity. *)
(* 					 		apply TotalOrder_Antisymmetric; assumption. *)
(* 					 		destruct (TotalOrder_Total (py fst) (py fst)). *)
(* 					 		reflexivity. *)
(* 					 		destruct s; *)
(* 					 		reflexivity. *)
(* 					 ****** destruct s.  *)
(* 					 	destruct (TotalOrder_Total (px G5) (py fst)). *)
(* 					 	destruct (TotalOrder_Total (px G5) (pz snd)). *)
(* 					 	reflexivity. *)
(* 					 	destruct s. *)
(* 					 	reflexivity. rewrite <- p in r.  *)
(* 					 	apply TotalOrder_Antisymmetric; assumption. *)
(* 					 	destruct s.  *)
(* 					 	destruct ( TotalOrder_Total (px G5) (pz snd)). *)
(* 					 	reflexivity. *)
(* 					 	destruct s. reflexivity. *)
(* 					 	apply (TotalOrder_Transitive (px G5)) in r.  *)
(* 					 	apply TotalOrder_Antisymmetric; assumption. *)
(* 					 	assumption. *)
(* 					 	destruct (TotalOrder_Total (py fst) (pz snd)). reflexivity. *)
(* 					 	destruct s. reflexivity. *)
(* 					 	apply TotalOrder_Antisymmetric; assumption. *)
(* 					 ******* *)
(* 					 	 	destruct ( TotalOrder_Total (px G5) (py fst)). *)
(* 					 	 	reflexivity. *)
(* 					 	 	destruct s. destruct (TotalOrder_Total (px G5) (pz snd)). *)
(* 					 	 	reflexivity. destruct s; reflexivity. *)
(* 					 	 	destruct ( TotalOrder_Total (px G5) (pz snd)). *)
(* 					 	 	rewrite <- p. *)
(* 					 	 	destruct (TotalOrder_Total (py fst) (px G5)). *)
(* 					 	 	apply symmetry; assumption. *)
(* 					 	 	destruct s. rewrite <- p in r. *)
(* 					 	 	apply TotalOrder_Antisymmetric; assumption. *)
(* 					 	 	reflexivity. destruct s.  *)
(* 					 	 	assert ((py fst) = (pz snd)). apply TotalOrder_Antisymmetric. *)
(* 					 	 	apply (TotalOrder_Transitive (py fst) (px G5)); assumption. *)
(* 					 	 	assumption. rewrite X2. assert (px G5 = pz snd). *)
(* 					 	 	 apply TotalOrder_Antisymmetric. assumption. *)
(* 					 	 	 apply (TotalOrder_Transitive (pz snd) (py fst)); assumption. *)
(* 					 	 	 rewrite X3. *)
(* 					 	 	destruct ( TotalOrder_Total (pz snd) (pz snd)). *)
(* 					 	 	reflexivity. destruct s; reflexivity. *)
(* 					 	 	destruct (TotalOrder_Total (py fst) (pz snd)). *)
(* 					 	 		 apply TotalOrder_Antisymmetric.  assumption. rewrite p. *)
(* 					 	 	 apply (TotalOrder_Reflexive).  destruct s.  *)
(* 					 	 		 apply TotalOrder_Antisymmetric;  assumption. reflexivity. *)
(* - intros. rewrite transport_dom_eq_gen. *)
(*   apply path_forall. intro y0. cbn. *)
(*    destruct  *)
(*   		(union_non_empty' x y  *)
(*   		(transport (fun X : FSet A => X <> ∅) (comm x y)^ y0)) as  *)
(*   		[[Hx Hy] | [ [Ha Hb] | [Hc Hd]]]; *)
(*   	destruct (union_non_empty' y x y0) as  *)
(*   	   [[H'x H'y] | [ [H'a H'b] | [H'c H'd]]]; *)
(*   	   try (eq_neq_tac).  *)
(*      assert (Hx = H'b).  apply path_forall. intro. *)
(* 		 apply path_ishprop. rewrite X. reflexivity. *)
(* 		 assert (Hb = H'x).  apply path_forall. intro. *)
(* 		 apply path_ishprop. rewrite X. reflexivity. *)
(* 		  assert (Hd = H'c).  apply path_forall. intro. *)
(* 		 apply path_ishprop. rewrite X. *)
(* 		  assert (H'd = Hc).  apply path_forall. intro. *)
(* 		 apply path_ishprop. *)
(* 		 rewrite X0. rewrite <- X. *)
(* 	destruct  *)
(* 		(TotalOrder_Total (px Hc) (py Hd)) as [G1 | [G2 | G3]]; *)
(* 	destruct  *)
(* 	(TotalOrder_Total (py Hd) (px Hc)) as [T1 | [T2 | T3]]; *)
(* 	try (assumption); *)
(* 	try (reflexivity); *)
(* 	try (apply symmetry; assumption); *)
(* 	try (apply TotalOrder_Antisymmetric; assumption). *)
		 		  
(* - intros. rewrite transport_dom_eq_gen. *)
(*   apply path_forall. intro y. *)
(*   destruct (union_non_empty' ∅ x (transport (fun X : FSet A => X <> ∅) (nl x)^ y)). *)
(*   destruct p. eq_neq_tac.  *)
(*   destruct s.  *)
(*   destruct p. *)
(*   assert (y = snd). *)
(*     apply path_forall. intro. *)
(*     apply path_ishprop. rewrite X. reflexivity. *)
(*   destruct p. destruct fst. *)
(* - intros. rewrite transport_dom_eq_gen. *)
(*   apply path_forall. intro y. *)
(*   destruct (union_non_empty' x ∅ (transport (fun X : FSet A => X <> ∅) (nr x)^ y)). *)
(*   destruct p. assert (y = fst).  apply path_forall. intro. *)
(* apply path_ishprop. rewrite X. reflexivity. *)
(*   destruct s.  *)
(*   destruct p.  *)
(*   eq_neq_tac. *)
(*   destruct p. *)
(*   destruct snd. *)
(* - intros. rewrite transport_dom_eq_gen. *)
(* 	apply path_forall. intro y.  *)
(*   destruct ( union_non_empty' {|x|} {|x|} (transport (fun X : FSet A => X <> ∅) (idem x)^ y)). *)
(*   reflexivity. *)
(*   destruct s. *)
(*   reflexivity. *)
(*   destruct p. *)
(*   cbn. destruct  (TotalOrder_Total x x). reflexivity. *)
(*   destruct s; reflexivity. *)
(* Defined. *)
	

Definition minfset {HFun: Funext} : 
	FSet A -> { Y: (FSet A) & (Y = E) + { a: A & Y = L a } }.
intro X.
hinduction X.
-  exists E. left. reflexivity.
- intro a.  exists (L a). right. exists a. reflexivity.
- intros IH1 IH2.
  destruct IH1 as [R1 HR1].
  destruct IH2 as [R2 HR2]. 
  destruct HR1. 
  destruct HR2.
  exists E; left. reflexivity.
  destruct s as [a Ha]. exists (L a). right.
  exists a. reflexivity.
  destruct HR2. 
  destruct s as [a Ha].
  exists (L a). right. exists a. reflexivity.
  destruct s as [a1 Ha1].
  destruct s0 as [a2 Ha2].
  assert (a1 = a2 \/ R a1 a2 \/ R a2 a1).
	apply TotalOrder_Total. 
	destruct X.
	exists (L a1). right. exists a1. reflexivity.
	destruct s.
	exists (L a1). right. exists a1. reflexivity.
  exists (L a2). right. exists a2. reflexivity.
  - cbn. intros R1 R2 R3.
  destruct R1 as [Res1 HR1].
  destruct HR1 as [HR1E | HR1S].
  destruct R2 as [Res2 HR2].
  destruct HR2 as [HR2E | HR2S].
  destruct R3 as [Res3 HR3].
  destruct HR3 as [HR3E | HR3S].
  + cbn. reflexivity.
 	+ cbn. reflexivity.
 	+ cbn.   destruct R3 as [Res3 HR3].
  destruct HR3 as [HR3E | HR3S].
  * cbn. reflexivity.
  * destruct HR2S as [a2 Ha2].  
    destruct HR3S as [a3 Ha3].
  	  destruct (TotalOrder_Total a2 a3).
  	  ** cbn. reflexivity.
  	  ** destruct s. cbn. reflexivity.
  	  	   cbn. reflexivity.  	
  	+  destruct HR1S as [a1 Ha1].
  	 destruct R2 as [Res2 HR2].
  destruct HR2 as [HR2E | HR2S].
  destruct R3 as [Res3 HR3].
  destruct HR3 as [HR3E | HR3S].
  * cbn. reflexivity.
  * destruct HR3S as [a3 Ha3].
    destruct (TotalOrder_Total a1 a3). 
    reflexivity.
    destruct s; reflexivity.
   * destruct HR2S as [a2 Ha2]. 
  destruct R3 as [Res3 HR3].
  destruct HR3 as [HR3E | HR3S].
    cbn. destruct (TotalOrder_Total a1 a2).
    cbn. reflexivity.
    destruct s.
    cbn. reflexivity.
    cbn. reflexivity.
    destruct HR3S as [a3 Ha3]. 
     destruct (TotalOrder_Total a2 a3).
     ** rewrite p. 
     destruct (TotalOrder_Total a1 a3).
     rewrite p0. 
     destruct ( TotalOrder_Total a3 a3).
     reflexivity.
     destruct s; reflexivity.
     destruct s. cbn.
     destruct (TotalOrder_Total a1 a3).
     reflexivity.
     destruct s. reflexivity.
     	assert (a1 = a3).
	  apply TotalOrder_Antisymmetric; assumption. 
	  rewrite X. reflexivity.
	  cbn. destruct (TotalOrder_Total a3 a3).
	  reflexivity.
	  destruct s; reflexivity.
    ** destruct s.
    		 *** cbn. destruct (TotalOrder_Total a1 a2).
    		 cbn. destruct (TotalOrder_Total a1 a3).
    		  reflexivity.
    		  destruct s. reflexivity.
    		  rewrite <- p in r.
    		    	assert (a1 = a3).
	  apply TotalOrder_Antisymmetric; assumption. 
	  rewrite X. reflexivity.
	    destruct s. cbn.
    	destruct (TotalOrder_Total a1 a3).
    	reflexivity.
    	destruct s. reflexivity.
    	assert (R a1 a3).
    apply (TotalOrder_Transitive a1 a2); assumption.
    assert (a1 = a3).
	  apply TotalOrder_Antisymmetric; assumption. 
	  rewrite X0. reflexivity.
    	cbn. destruct (TotalOrder_Total a2 a3).
    	reflexivity.
    	destruct s.
    	reflexivity.
    assert (a2 = a3).
	  apply TotalOrder_Antisymmetric; assumption. 
	  rewrite X. reflexivity.
   *** cbn. destruct (TotalOrder_Total a1 a3).
   rewrite p. destruct (TotalOrder_Total a3 a2).
   cbn. destruct (TotalOrder_Total a3 a3).
   reflexivity. destruct s; reflexivity.
   destruct s. cbn.
   destruct (TotalOrder_Total a3 a3).
   reflexivity. destruct s; reflexivity.
   cbn. destruct (TotalOrder_Total a2 a3).
   rewrite p0.
   reflexivity.
   destruct s. 
    assert (a2 = a3).
	  apply TotalOrder_Antisymmetric; assumption. 
	  rewrite X. reflexivity. reflexivity.
	  destruct s.
	  cbn.
    destruct (TotalOrder_Total a1 a2).
    cbn. 
  destruct (TotalOrder_Total a1 a3).
  reflexivity.
  assert (a1 = a3).
  apply TotalOrder_Antisymmetric. assumption.
  rewrite <- p in r. assumption.
  destruct s. reflexivity. rewrite X. reflexivity.
  destruct s. cbn. 
  destruct (TotalOrder_Total a1 a3). reflexivity.
  destruct s. reflexivity.
  assert (a1 = a3).
  apply TotalOrder_Antisymmetric; assumption.
  rewrite X. reflexivity.
  cbn.  destruct  (TotalOrder_Total a2 a3).
  rewrite p in r1.
  assert (a2 = a1).
  transitivity a3.
  assumption.
  apply TotalOrder_Antisymmetric; assumption.
  rewrite X. reflexivity.
  destruct s. 
   assert (a1 = a2).
    apply TotalOrder_Antisymmetric.
   apply (TotalOrder_Transitive a1 a3); assumption.
   assumption.
  rewrite X. reflexivity.
   assert (a1 = a3).
    apply TotalOrder_Antisymmetric.
    assumption.
   apply (TotalOrder_Transitive a3 a2); assumption.
   rewrite X. reflexivity.
  destruct ( TotalOrder_Total a1 a2).
  cbn.
  destruct (TotalOrder_Total a1 a3).
  rewrite p0.
  reflexivity.
  destruct s. 
  assert (a1 = a3).
    apply TotalOrder_Antisymmetric; assumption. 
    rewrite X. reflexivity. reflexivity. 
  destruct s.
  cbn.
  destruct (TotalOrder_Total a1 a3 ).
  rewrite p.
  reflexivity.
  destruct s. 
    assert (a1 = a3).
    apply TotalOrder_Antisymmetric; assumption. 
    rewrite X. reflexivity. reflexivity. 
  cbn.
  destruct (TotalOrder_Total a1 a3 ).
  assert (a2 = a3).
  rewrite p in r1.
  apply TotalOrder_Antisymmetric; assumption. 
	  rewrite X. destruct (TotalOrder_Total a3 a3). reflexivity.
	  destruct s; reflexivity.
  destruct s. 
  destruct (TotalOrder_Total a2 a3).
  rewrite p.
  reflexivity.
  destruct s.
    assert (a2 = a3).
	  apply TotalOrder_Antisymmetric; assumption. 
	  rewrite X. reflexivity.
	  reflexivity.
   	cbn. destruct (TotalOrder_Total a2 a3).
   	rewrite p.
    	reflexivity.
    	destruct s.
    	assert (a2 = a3).
    	  apply TotalOrder_Antisymmetric; assumption.
    	  rewrite X. reflexivity. reflexivity.
  - cbn. intros R1 R2. 
  destruct R1 as [La1 HR1].
  destruct HR1 as [HR1E | HR1S]. 
  destruct R2 as [La2 HR2].
  destruct HR2 as [HR2E | HR2S].
  reflexivity.
  reflexivity.
  destruct R2 as [La2 HR2].
  destruct HR2 as [HR2E | HR2S].
  reflexivity.
  destruct HR1S as [a1 Ha1].
  destruct HR2S as [a2 Ha2].
  destruct (TotalOrder_Total a1 a2).
  rewrite p.
  destruct (TotalOrder_Total a2 a2).
  reflexivity.
  destruct s; reflexivity.
	destruct s.
	destruct (TotalOrder_Total a2 a1).
	rewrite p.
	reflexivity.
	destruct s.
	assert (a1 = a2).
	apply TotalOrder_Antisymmetric; assumption.
	rewrite X.
	reflexivity.
	reflexivity.
	destruct (TotalOrder_Total a2 a1).
	rewrite p.
	reflexivity.
	destruct s.
	reflexivity.
		assert (a1 = a2).
	apply TotalOrder_Antisymmetric; assumption.
	rewrite X.
	reflexivity.
  - cbn. intro R. destruct R as [La HR].
  destruct HR. rewrite <- p. reflexivity.
  destruct s as [a1 H].
  apply (path_sigma' _  H^).
  rewrite transport_sum.
  f_ap.
  rewrite transport_sigma.
  simpl.
  simple refine (path_sigma' _ _ _ ).
  apply transport_const.
  apply set_path2.

  - intros R. cbn. 
  destruct R as [ R  HR].
  destruct HR as [HE | Ha ].
  rewrite <- HE. reflexivity.
  destruct Ha as [a Ha].
  apply (path_sigma' _  Ha^).
  rewrite transport_sum.
  f_ap.
  rewrite transport_sigma.
  simpl.
  simple refine (path_sigma' _ _ _ ).
  apply transport_const.
  apply set_path2.
  - cbn. intro. 
  destruct (TotalOrder_Total x x).
  reflexivity.
  destruct s.
  reflexivity.
  reflexivity.
Defined.