Require Import HoTT
 Nat.

Fixpoint lt (n k : nat) : Type :=
  match n with
  | O => Empty
  | S n' => match k with
    | O => Unit
    | S k' => (lt n' k') end end.

Fixpoint lt_b (n k : nat) : Bool :=
  match n with
  | O => false
  | S n' => match k with
    | O => true
    | S k' => (lt_b n' k') end end.

Lemma hset_lt (n k : nat) : IsHProp (lt n k).
Proof.
  revert k.
  induction n.
  intros k x y.
    destruct x.
  intros k x y.
    destruct k.
      simpl in x, y.
        destruct x.
        exists (eta_unit _).
        intro.
        apply path2_contr.
      simpl in x, y.
      apply IHn.
Defined.

Lemma lt_trans {k l m : nat} : lt k l -> lt l m -> lt k m.
Proof.
  revert l m.
  induction k.
  intros.
  destruct X.
  intros.
    destruct l.
      destruct X0.
    destruct m.
      exact tt.
      exact (IHk l m X X0).
Defined.

Lemma ltz_lt { k l } : lt k l -> lt k 0.
Proof.
  destruct k.
  intros [].
  intros. exact tt.
Defined.

Lemma lt_strongTrans { k l m } : lt k l -> lt l m -> lt k (S m).
Proof.
  revert k l.
  induction m.
  intros.
    destruct k.
      destruct X.
    destruct l. destruct X0.
    simpl.
    simpl in X.
    exact ( ltz_lt X ).
  intros.
    destruct k. destruct X.
    destruct l. destruct X0.
    simpl in *.
    exact (IHm _ _ X X0).
Defined.

Fixpoint lt_S (k : nat) : lt (S k) k :=
  match k with
| O => tt
| S k' => (lt_S k') end.

Lemma opt_ltS { m n } : lt (S m) n -> ( m = n ) \/ ( lt m n ).
Proof.
  revert n.
  induction m.
  intros.
    destruct n.
    auto.
    destruct X.
  intros.
    destruct n.
    right. auto.
    destruct ( IHm n X ).
    left. exact (ap S p).
    right. auto.
Defined.

Lemma nLt_xx { x : nat } : lt x x -> Empty.
Proof.
  induction x.
  auto.
  apply IHx.
Defined.
(**
*)

Fixpoint LT (m : nat) : Type :=
  match m with
  | O => Empty
  | S m' => sum Unit (LT m') end.

Definition LT_S { m : nat } :
  LT m -> LT (S m) := inr.

Fixpoint LT_plus { m : nat } :
  LT m -> LT (S m) :=
 match m with
 | O => fun x => match x with end
 | S m' =>
  fun x =>
    match x with
    | inl _ => inl tt
    | inr x => inr (LT_plus x) end end.

Definition LT_Top (m : nat) : LT (S m) := inl tt.

Fixpoint LT_z (m : nat) : LT (S m) :=
  match m with
  | O => inl tt
  | S m' => inr (LT_z m') end.

(*

Definition LT_S {m : nat} : LT m -> LT (S m).
Proof.
  intros [k ord].
  exists k.
  exact ( lt_trans (lt_S m) ord).
Defined.

Definition LT_Top (m : nat) : LT (S m) :=
  existT _ m (lt_S m).

Definition LT_plus { l : nat } : LT l -> LT (S l).
Proof.
  intros [ k ordk ].
  exists (S k).
  auto.
Defined.

Definition LT_z (l : nat) : LT (S l) :=
  ( 0 ; tt ).
*)

Fixpoint idx { m : nat } :
  LT m -> nat :=
match m with
 | O => fun x => match x with end
 | S m' =>
  fun x =>
  match x with
    | inl _ => m'
    | inr x' => idx x' end end.

Fixpoint idx_lt { m : nat } :
  forall z : LT m,
    lt m (idx z).
Proof.
  destruct m.
  intros [].
  intros.
  destruct z.
  apply lt_S.
  refine (lt_trans (lt_S _) _).
  simpl.
  apply idx_lt.
Defined.

Definition lt_Lt { m : nat } (k l : LT m) :=
  lt ( idx k ) (idx l).

Definition lt_Lt_trans { n : nat } { k l m : LT n } :
 lt_Lt k l -> lt_Lt l m -> lt_Lt k m.
Proof.
  apply lt_trans.
Defined.

Lemma eq_m_eq { n : nat } { k l : LT n } :
  idx k = idx l -> k = l.
Proof.
  induction n.
    destruct l.
  intros.
    destruct k.
    destruct l.
      destruct u; destruct u0; auto.
      destruct u. simpl in H.
      destruct
        (nLt_xx (transport (fun z => lt n z) H^ (idx_lt l))).
    destruct l.
      simpl in H.
        destruct (nLt_xx (transport (lt n) H (idx_lt l0))).
      simpl in H.
      apply ap.
      apply IHn.
      auto.
Defined.

Lemma dec_eq_mval { l : nat } : decidable_paths (LT l).
Proof.
  intros x y.
  destruct ( dec_eq_nat (idx x) (idx y) ).
    left.
    apply eq_m_eq. auto.
    right.
    intro. apply n.
    apply ap. auto.
Defined.

(* ~~~~~ *)

Fixpoint lType (l : nat) : Type :=
  match l with
  | 0 => Unit
  | S l' => Type * lType l' end.

Fixpoint lSect { l : nat } : lType l -> Type :=
  match l return (lType l -> Type)
  with
  | O => fun _ => Unit
  | S l' =>
    fun ( T : Type * lType l' ) =>
      let ( t , T' ) := T in t * lSect T' end.

Fixpoint lLT (T : Type) (l : nat) : lType l :=
  match l with
  | O => tt
  | S l' => ( T , lLT T l' ) end.

Fixpoint l_monOp (W : Type -> Type) { l : nat } :
  lType l -> lType l :=
  match l return lType l -> lType l with
  | O => fun _ => tt
  | S l' => fun X : lType (S l') => ( W (fst X), l_monOp W (snd X)) end.

Fixpoint l_pairOp (W : Type -> Type -> Type) { l : nat } :
 lType l -> lType l -> lType l :=
match l return lType l -> lType l -> lType l with
  | O => fun _ _ => tt
  | S l' => fun Ta Tb =>
    ( W (fst Ta) (fst Tb) , l_pairOp W (snd Ta) (snd Tb)) end.

Definition l_prod { l } ( A B : lType l ) := (l_pairOp prod A B).
Definition l_sum { l } ( A B : lType l ) := (l_pairOp sum A B).
Definition l_map { l } ( A B : lType l ) := (l_pairOp (fun X Y => X -> Y) A B).

Definition lList := (fun A => fun l => lSect (lLT A l)).

Fixpoint lKonst { A: Type } (a : A) l : lList A l :=
  match l with
  | O => tt
  | S l' => ( a, lKonst a l') end.

Fixpoint lKMap { A B : Type }(f : A -> B) l :
  lSect (l_map (lLT A l) (lLT B l)) :=
  match l with
  | O => tt
  | S l' => ( f , lKMap f l' ) end.

Fixpoint lT_fun { l : nat } :
( LT l -> Type ) -> lType l :=
match l return ( LT l -> Type) -> lType l with
 | O => fun _ => tt
 | S l' => fun f : LT (S l') -> Type =>
   ( f ( LT_Top _ ) , lT_fun ( f o LT_S) ) end.

Fixpoint lS_fun { l : nat } :
  forall { T : LT l -> Type }, ( forall z, T z ) ->  lSect (lT_fun T) :=
match l return ( forall T : LT l -> Type, (forall z, T z) -> lSect (lT_fun T) )
 with
 | O => fun _ _ => tt
 | S l' =>
  fun T : (LT (S l') -> Type ) =>
    fun f : forall z, T z =>
     ( f ( LT_Top _ ) , lS_fun ( fun r : LT l' => f (LT_S r) ) ) end.

Fixpoint lS_eqn { l : nat } :
  forall { T : LT l -> Type }, forall {f g : forall z, T z },
   f == g -> ( lS_fun f = lS_fun g ) :=
match l return ( forall { T : LT l -> Type }, forall {f g : forall z, T z },
   f == g -> ( lS_fun f = lS_fun g ) ) with
 | O => fun T f g h => @idpath _ tt
 | S l' => fun T f g h =>
  @path_prod _ _ (lS_fun f) (lS_fun g)
    (h (LT_Top _)) (lS_eqn (fun z => h (LT_S z))) end.

Fixpoint lS_map { l : nat } :
 forall { U V : LT l -> Type } ( f : forall z, U z -> V z ),
 ( lSect ( lT_fun U ) ) -> ( lSect (lT_fun V) ).
Proof.
  destruct l as [ | l'].
  intros U V f s.
  exact tt.
  intros U V f s.
  destruct s as [ s0 s' ].
  exact ( f _ s0 , lS_map l' _ _ (fun z => f ( LT_S z)) s' ).
Defined.

Fixpoint lT_map { l : nat } :
  forall { U : LT l -> Type } (f : forall z, U z -> Type) ,
  ( lSect ( lT_fun U ) ) -> lType l.
Proof.
  destruct l as [ | l' ].
  intros U f s.
  exact tt.
  intros U f [ s0 s' ].
  exact ( f _ s0 , lT_map l' _ (fun z => f (LT_S z)) s').
Defined.

Fixpoint lS_tMap { l : nat } :
 forall {U : LT l -> Type }
  { f : forall z, U z -> Type }
  { s : forall z, U z  }
  (h : lSect ( lT_fun (fun z => f z ( s z )) )),
 lSect ( lT_map f (lS_fun s) ).
Proof.
  destruct l as [ | l' ].
  intros.
  exact tt.
  intros.
  exact ( fst h , lS_tMap _ _ (fun z => f (LT_S z)) (fun z => s (LT_S z)) (snd h) ).
Defined.

Fixpoint lS_Mapt { l : nat } :
  forall { U : LT l -> Type }
   { f : forall z, U z -> Type }
   { s : forall z, U z }
  ( h : lSect (lT_map f (lS_fun s))),
  lSect (lT_fun (fun z => f z ( s z))).
Proof.
  destruct l as [ | l' ].
  intros.
  exact tt.
  intros.
  exact ( fst h, lS_Mapt _ _ (fun z => f (LT_S z)) (fun z => s (LT_S z)) (snd h)).
Defined.

Fixpoint fun_lS { l : nat } :
  forall (U : LT l -> Type ), lSect (lT_fun U) -> forall z, U z.
Proof.
  destruct l.
  intros U f [].
  intros U f z.
  destruct z as [ [] | z ].
  simpl in *.
  exact ( fst f ).
  refine (fun_lS l _ (snd f) z ).
Defined.

Fixpoint fun_lT { l : nat } :
  (lType l) -> (LT l) -> Type.
Proof.
  destruct l.
    intros _ [ ].
    intros T z.
    destruct z.
      exact (fst T).
      exact (fun_lT l (snd T) l0).
Defined.

Fixpoint lS_fun' { l : nat } :
  forall ( T : lType l ),
    (forall z, (fun_lT T) z) -> lSect T.
Proof.
  destruct l.
  intros. exact tt.
  intros.
  destruct T as [ T0 T ].
  split.
  exact ( X (LT_Top _)).
  exact ( lS_fun' _ T (fun z => X (LT_S z))).
Defined.

Fixpoint lT_S { l : nat } :
  lList Type l -> lType l :=
match l return (lList Type l -> lType l) with
| O => fun _ => tt
| S l' =>
  fun L : lList Type (S l') =>
    ( fst L , lT_S (snd L)) end.

Fixpoint lS_T { l : nat } :
  lType l -> lList Type l :=
match l return (lType l -> lList Type l) with
| O => fun _ => tt
| S l' =>
  fun L : lType (S l') =>
    ( fst L , lS_T (snd L)) end.

Fixpoint l_LPair { A B : Type } { l } :
  lList A l -> lList B l -> lList ( A * B ) l :=
match l return lList A l -> lList B l -> lList ( A * B ) l with
| O => fun _ _ => tt
| S l' =>
  fun aa bb => ( ( fst aa, fst bb ), l_LPair (snd aa) (snd bb)) end.

Fixpoint l_Lfst { A B : Type } { l : nat } :
  lList (A * B) l -> lList A l :=
match l with
 | O => fun _ => tt
 | S l' => fun W =>
  (fst (fst W) , l_Lfst (snd W) ) end.

Fixpoint l_Lsnd { A B : Type } { l : nat } :
  lList (A * B) l -> lList B l :=
match l with
 | O => fun _ => tt
 | S l' => fun W =>
  (snd (fst W), l_Lsnd (snd W) ) end.

Fixpoint lf_t_elim { l : nat } :
  forall T : LT l -> Type,
    forall z, T z ->
      fun_lT (lT_fun T) z.
Proof.
  induction l.
  intros.
    destruct z.
  intros.
    destruct z.
      simpl. destruct u. exact X.
      simpl.
      unfold compose.
      auto.
Defined.


Require Import Iron.Language.SystemF2.KiJudge.

(* Substitution of types in types preserves kinding.
   Must also subst new new type into types in env higher than ix
   otherwise indices that reference subst type are broken, and
   the resulting type env would not be well formed *)
Theorem subst_type_type_ix
 :  forall ix ke t1 k1 t2 k2
 ,  get ix ke = Some k2
 -> KIND ke t1 k1
 -> KIND (delete ix ke) t2 k2
 -> KIND (delete ix ke) (substTT ix t2 t1) k1.
Proof.
 intros. gen ix ke t2 k1 k2.
 induction t1; intros; simpl; inverts_kind; eauto.

 Case "TVar".
  fbreak_nat_compare.
  SCase "n = ix".
   rewrite H in H4.
   inverts H4. auto.

  SCase "n < ix".
   apply KIVar. rewrite <- H4.
   apply get_delete_above; auto.

  SCase "n > ix".
   apply KIVar. rewrite <- H4.
   destruct n.
    burn.
    simpl. nnat. apply get_delete_below. omega.

 Case "TForall".
  apply KIForall.
  rewrite delete_rewind.
  eapply IHt1; eauto.
   apply kind_kienv_weaken; auto.
Qed.

Theorem subst_type_type_ix_forall2
 :  forall ix ke t2 k2 ts ks
 ,  get ix ke = Some k2
 -> Forall2 (KIND ke) ts ks
 ->          KIND (delete ix ke) t2 k2
 -> Forall2 (KIND (delete ix ke)) (map (substTT ix t2) ts) ks.
Proof.
 intros.
 eapply Forall2_map_left.
 apply (Forall2_impl
            (fun t k => KIND ke t k)
            (fun t k => KIND (delete ix ke) (substTT ix t2 t) k)
            ts ks).
  intros. eapply subst_type_type_ix; eauto.
  eauto.
Qed.

Theorem subst_type_type
 :  forall ke t1 k1 t2 k2
 ,  KIND (ke :> k2) t1 k1
 -> KIND ke         t2 k2
 -> KIND ke (substTT 0 t2 t1) k1.
Proof.
 intros.
 unfold substTT.
 rrwrite (ke = delete 0 (ke :> k2)).
 eapply subst_type_type_ix; burn.
Qed.


(** Uma biblioteca em Coq para testes baseados em modelos **)

Require Import String.
Require Import Coq.Lists.List.
Require Import Coq.Lists.ListSet.
Import Coq.Lists.List.ListNotations.
Require Import PeanoNat.

(* Definition 1 *)
Section SectionLTS.
  Definition state  := nat.
  Definition label := string.
  Inductive transition_label :=
  | event : label -> transition_label
  | tau   : transition_label.

  Local Open Scope type_scope.
  Definition transition := state * transition_label * state.
  Local Close Scope type_scope.

  Theorem transition_label_dec : forall x y : transition_label, {x = y} + {x <> y}.
  Proof.
    decide equality.
    apply string_dec.
  Defined.

  Theorem transition_dec : forall x y : transition, {x = y} + {x <> y}.
  Proof.
    decide equality.
    - apply Nat.eq_dec.
    - decide equality.
      + decide equality.
        apply string_dec.
      + apply Nat.eq_dec.
  Defined.

  Fixpoint each_transition_is_valid
    (t : list transition) (Q : list state) (L : list label) : Prop :=
      match t with
      | []                      => True
      | (s1, event l, s2) :: tl => In s1 Q /\ In s2 Q /\ In l L /\
                                   each_transition_is_valid tl Q L
      | (s1, tau, s2) :: tl     => In s1 Q /\ In s2 Q /\
                                   each_transition_is_valid tl Q L
      end.

  Record LTS : Type := mkLTS {
      Q   : set state
    ; L   : set label
    ; T   : set transition
    ; q0  : state

    ; Q_non_empty       : Q <> []
    ; q0_in_Q           : In q0 Q
    ; valid_transitions : each_transition_is_valid T Q L
    ; no_repetition_Q   : NoDup Q
    ; no_repetition_L   : NoDup L
    ; no_repetition_T   : NoDup T
  }.
End SectionLTS.

(** Definition 3*)
Inductive ind_transition : state -> transition_label -> state -> LTS -> Prop :=
  | transition_r1 (s s' : state) (l : label) (p : LTS):
      In (s, event l, s') p.(T) ->
      ind_transition s (event l) s' p
  | transition_r2 (s s' : state) (p : LTS) :
      In (s, tau, s') p.(T) ->
      ind_transition s tau s' p.

Inductive ind_transition_seq : state -> list transition_label -> state -> LTS -> Prop :=
  | transition_seq_r1 (s s' : state) (l : transition_label) (p : LTS) :
      ind_transition s l s' p ->
      ind_transition_seq s [l] s' p
  | transition_seq_r2  (s s' si : state) (l1 l2 : transition_label)
        (ll : list transition_label) (p : LTS) :
      ind_transition s l1 si p ->
      ind_transition_seq si (l2 :: ll) s' p ->
      ind_transition_seq s (l1 :: l2 :: ll) s' p.

Inductive ind_state_reaches_some_other : state -> list transition_label -> LTS -> Prop :=
  | state_reaches_some_other_r1 (s s': state) (ll : list transition_label) (p : LTS) :
      ind_transition_seq s ll s' p ->
      ind_state_reaches_some_other s ll p.

(** Definition 4*)
Inductive ind_empty_reachability : state -> state -> LTS -> Prop :=
  | empty_reachability_r1 (s : state) (p : LTS) :
      ind_empty_reachability s s p
  | empty_reachability_r2 (s si s' : state) (p : LTS) :
      ind_transition s tau si p ->
      ind_empty_reachability si s' p ->
      ind_empty_reachability s s' p.

Inductive ind_one_step_reachability : state -> label -> state -> LTS -> Prop :=
  | one_step_reachability_r1 (s s' s1 s2 : state) (l : label) (p : LTS) :
      ind_empty_reachability s s1 p ->
      ind_transition s1 (event l) s2 p ->
      ind_empty_reachability s2 s' p ->
      ind_one_step_reachability s l s' p.

Inductive ind_seq_reachability : state -> list label -> state -> LTS -> Prop :=
  | seq_reachability_r1 (s s' : state) (p : LTS) :
      ind_empty_reachability s s' p ->
      ind_seq_reachability s [] s' p
  | seq_reachability_r2 (s si s' : state) (l1: label) (ll : set label) (p : LTS) :
      ind_one_step_reachability s l1 si p ->
      ind_seq_reachability si ll s' p ->
      ind_seq_reachability s (l1 :: ll) s' p.

Inductive ind_has_reachability_to_some_other : state -> list label -> LTS -> Prop :=
  | has_reachability_to_some_other_r1 (s s' : state) (ll : list label) (p : LTS) :
      ind_seq_reachability s ll s' p ->
      ind_has_reachability_to_some_other s ll p.

Inductive ind_init : state -> set transition_label -> LTS -> Prop :=
  | init_r1 (s : state) (ll : set transition_label) (p : LTS) :
      (forall (l : transition_label),
        In l ll <-> exists (s' : state), In (s, l, s') p.(T)) ->
      ind_init s ll p.

Inductive ind_init_LTS : set transition_label -> LTS -> Prop :=
  | init_LTS_r1 (ll : set transition_label) (p : LTS) :
      ind_init p.(q0) ll p -> ind_init_LTS ll p.

(* TODO: we have analysed the definitions up to this point *)

(* Definition 5.2 *)
Inductive ind_traces : state -> list label -> LTS -> Prop :=
  | traces_r1 (s : state) (t : list label) (p : LTS) :
      ind_has_reachability_to_some_other s t p ->
      ind_traces s t p.

Inductive ind_traces_LTS : list label -> LTS -> Prop :=
  | traces_LTS_r1 (ll : list label) (p : LTS) :
      ind_traces p.(q0) ll p -> ind_traces_LTS ll p.

(* Definition 5.3 *)
Definition ind_after (s : state) (ll : list label) (ls : list state) (p : LTS)
    : Prop :=
  forall (a : state), ind_seq_reachability s ll a p <-> In a ls.

Inductive ind_after_LTS : list label -> list state -> LTS -> Prop :=
  | after_LTS_r1 (ll : list label) (ls : list state) (p : LTS) :
      ind_after p.(q0) ll ls p ->
      ind_after_LTS ll ls p.

(* Definition 5.4 *)
Inductive ind_P_after_sigma : set state -> list label -> set state -> LTS -> Prop :=
  | P_after_sigma_r1 (P : set state) (t : list label) (ls : set state) (p : LTS) :
      (forall (s' : state),
        In s' ls <->
        exists (s : state), In s P /\ ind_seq_reachability s t s' p) ->
      ind_P_after_sigma P t ls p.

(* Definition 5.5 *)
Fixpoint elem_has_no_transition_in_A (s : state) (ll : set transition_label)
    (p : LTS) : Prop :=
  match ll with
  | []        =>  True
  | h :: tail =>  ~ ind_state_reaches_some_other s [h] p /\
                    elem_has_no_transition_in_A s tail p
  end.

Inductive ind_refuses : set state -> set transition_label -> LTS -> Prop :=
  | refuses_r1 (ls : set state) (s : state) (ll : set transition_label) (p : LTS) :
      In s ls ->
      elem_has_no_transition_in_A s (set_add transition_label_dec tau ll) p ->
      ind_refuses ls ll p.

(* Definition 5.6 *)
Inductive ind_der : state -> set state -> LTS -> Prop :=
  | der_r1 (s: state) (ls : set state) (p : LTS) :
      (forall (s' : state),
        (exists (ll : list label), ind_seq_reachability s ll s' p) <-> In s' ls) ->
      ind_der s ls p.

Inductive ind_der_LTS : set state -> LTS -> Prop :=
  | der_LTS_r1 (ls : set state) (p : LTS) :
      ind_der p.(q0) ls p ->
      ind_der_LTS ls p.

(* Definition 5.7 *)
Definition has_finite_behaviour (s : state) (lts : LTS) : Prop :=
  exists (n : nat),
    forall (t : list label),
      ind_traces s t lts -> length t <= n.

Definition has_finite_behaviour_LTS (lts : LTS) : Prop :=
  exists (n : nat),
    forall (t : list label),
      ind_traces lts.(q0) t lts -> length t <= n.

(* Definition 5.8 *)
Definition finite_state (p : state) (lts : LTS) : Prop :=
  exists (n : nat),
    forall (ls : set state),
      ind_der p ls lts -> length ls < n.

Definition finite_state_LTS (lts : LTS) : Prop :=
  exists (n : nat),
    forall (ls : set state),
      ind_der_LTS ls lts -> length ls < n.

(* Definition 5.9 *)
Definition ind_deterministic (lts : LTS) : Prop :=
  forall (t : list label) (ls : set state),
    ind_traces_LTS t lts ->
    ind_after_LTS t ls lts ->
    NoDup ls ->
    length ls = 1.

(* Definição 5.10 *)
Definition image_finite (p : state) (lts : LTS) : Prop :=
    forall (ll : list label) (ls : set state),
      incl ls lts.(Q) /\ ind_after p ll ls lts -> exists (n : nat), length ls < n.

Definition image_finite_LTS (lts : LTS) : Prop :=
  image_finite lts.(q0) lts.

(* Definição 5.11 *)
Fixpoint all_labels_tau (ll : list transition_label) : Prop :=
  match ll with
  | []      => True
  | h :: tl => h = tau /\ all_labels_tau tl
  end.

(* Definição 5.12 *)
Definition strongly_converging (lts : LTS) : Prop :=
  forall (s : state) (t : list transition_label),
    t <> [] /\ all_labels_tau t ->
    ~ ind_transition_seq s t s lts.

(* Strongly converging LTS *)
Record SC_LTS : Type := mkSC_LTS {
      lts : LTS
    ; is_strongly_converging  : strongly_converging lts
  }.


(** * 6.512 Formal Reasoning About Programs, Spring 2023 - Pset 3 *)

Require Coq816.
Require Import Frap.Frap ZArith.

(* three-way comparisions, and [cases] support for them *)
Notation Lt := (inleft (left _)) (only parsing).
Notation Eq := (inleft (right _)) (only parsing).
Notation Gt := (inright _) (only parsing).

Definition compare
  : forall n m : Z,
    (sumor (sumbool (n < m) (n = m)) (m < n))%Z.
Proof.
  refine (fun n m => match Zorder.Ztrichotomy_inf n m with
                     | Lt => _
                     | Eq => _
                     | Gt => _
                     end).
  all: auto.
  right; linear_arithmetic.
Defined.

Module Type S.
  Inductive tree {A} :=
  | Leaf
  | Node (l : tree) (d : A) (r : tree).
  Arguments tree : clear implicits.

  Fixpoint flatten {A} (t : tree A) : list A :=
    match t with
    | Leaf => []
    | Node l d r => flatten l ++ d :: flatten r
    end.

  (* 1a) HOFs: id and compose *)

  Definition id {A : Type} (x : A) : A := x.
  Definition compose {A B C : Type} (g : B -> C) (f : A -> B) (x : A) : C := g (f x).

  (*[0.5%]*)
  Parameter compose_id_l : forall (A B : Type) (f : A -> B), compose id f = f.

  (*[0.5%]*)
  Parameter compose_id_r : forall (A B : Type) (f : A -> B), compose f id = f.

  (*[1%]*)
  Parameter compose_assoc :
    forall (A B C D : Type) (f : A -> B) (g : B -> C) (h : C -> D),
      compose h (compose g f) = compose (compose h g) f.

  Fixpoint selfCompose{A: Type}(f: A -> A)(n: nat): A -> A :=
    match n with
    | O => id
    | S n' => compose f (selfCompose f n')
    end.

  Parameter exp : nat -> nat -> nat.
  (*[0.25%]*)
  Parameter test_exp_3_2 : exp 3 2 = 9.
  (*[0.25%]*)
  Parameter test_exp_4_1 : exp 4 1 = 4.
  (*[0.25%]*)
  Parameter test_exp_5_0 : exp 5 0 = 1.
  (*[0.25%]*)
  Parameter test_exp_1_3 : exp 1 3 = 1.

  (* 1b) HOFs: Left inverses *)

  Definition left_inverse{A B: Type}(f: A -> B)(g: B -> A): Prop := compose g f = id.

  (*[1%]*)
  Parameter plus2minus2 : left_inverse (fun x : nat => x + 2) (fun x : nat => x - 2).

  (*[2.5%]*)
  Parameter minus2plus2 : ~ left_inverse (fun x : nat => x - 2) (fun x : nat => x + 2).

  (*[4%]*)
  Parameter left_invertible_injective:
    forall {A} (f g: A -> A),
      left_inverse f g ->
      (forall x y, f x = f y -> x = y).

  (*[0.25%]*)
  Parameter left_inverse_id : forall {A : Type}, left_inverse (@id A) (@id A).

  (*[8%]*)
  Parameter invert_selfCompose :
    forall {A : Type} (f g : A -> A) (n : nat), left_inverse f g -> left_inverse (selfCompose f n) (selfCompose g n).

  (* 2a) bitwise tries *)

  Definition bitwise_trie A := tree (option A).

  Parameter lookup : forall {A : Type}, list bool -> bitwise_trie A -> option A.

  (*[1%]*)
  Parameter lookup_example1 : lookup nil (Node Leaf (None : option nat) Leaf) = None.

  (*[1%]*)
  Parameter lookup_example2 :
    lookup (false :: true :: nil)
           (Node (Node Leaf (Some 2) Leaf) None (Node (Node Leaf (Some 1) Leaf) (Some 3) Leaf)) =
    Some 1.

  (*[1%]*)
  Parameter lookup_empty : forall {A : Type} (k : list bool), lookup k (Leaf : bitwise_trie A) = None.

  Parameter insert : forall {A : Type}, list bool -> option A -> bitwise_trie A -> bitwise_trie A.

  (*[1%]*)
  Parameter insert_example1 : lookup nil (insert nil None (Node Leaf (Some 0) Leaf)) = None.

  (*[1%]*)
  Parameter insert_example2 :
    lookup nil (insert (true :: nil) (Some 2) (Node Leaf (Some 0) Leaf)) = Some 0.

  (*[8%]*)
  Parameter lookup_insert :
    forall {A : Type} (k : list bool) (v : option A) (t : bitwise_trie A), lookup k (insert k v t) = v.

  Parameter merge : forall {A : Type}, bitwise_trie A -> bitwise_trie A -> bitwise_trie A.

  (*[0.25%]*)
  Parameter merge_example1 :
    merge (Node Leaf (Some 1) Leaf) (Node Leaf (Some 2) Leaf) =
    Node Leaf (Some 1) Leaf.

  (*[0.5%]*)
  Parameter merge_example2 :
    merge Leaf (Node Leaf (@None nat) Leaf) = Node Leaf None Leaf.

  (*[0.5%]*)
  Parameter merge_example3 :
    merge (Node Leaf None Leaf) (Node Leaf (Some 2) Leaf) =
    Node Leaf (Some 2) Leaf.

  (*[3%]*)
  Parameter left_lookup_merge : forall {A : Type} (t1 t2 : bitwise_trie A) k v,
      lookup k t1 = Some v ->
      lookup k (merge t1 t2) = Some v.

  (*[4%]*)
  Parameter lookup_merge_None : forall {A : Type} (t1 t2 : bitwise_trie A) k,
      lookup k (merge t1 t2) = None ->
      lookup k t1 = None /\ lookup k t2 = None.

  (*[5%]*)
  Parameter merge_selfCompose : forall {A : Type} n (t1 t2 : bitwise_trie A),
      0 < n ->
      selfCompose (merge t1) n t2 = merge t1 t2.

  Parameter mirror : forall {A : Type}, tree A -> tree A.

  (*[1%]*)
  Parameter mirror_test1 :
    mirror (Node Leaf 1 (Node Leaf 2 (Node Leaf 3 Leaf))) =
    Node (Node (Node Leaf 3 Leaf) 2 Leaf) 1 Leaf.

  (*[0.5%]*)
  Parameter mirror_mirror_id : forall {A : Type} (t : tree A),
      mirror (mirror t) = t.

  (*[3%]*)
  Parameter flatten_mirror_rev : forall {A : Type} (t : tree A),
      flatten (mirror t) = rev (flatten t).

  (* 2b) HOFs: tree_map *)

  Parameter tree_map : forall {A B : Type}, (A -> B) -> tree A -> tree B.

  (*[1%]*)
  Parameter tree_map_example :
    tree_map (fun x : nat => x + 1) (Node (Node Leaf 1 Leaf) 2 (Node Leaf 3 (Node Leaf 4 Leaf))) =
    Node (Node Leaf 2 Leaf) 3 (Node Leaf 4 (Node Leaf 5 Leaf)).

  (*[8%]*)
  Parameter tree_map_flatten :
    forall (A B : Type) (f : A -> B) (t : tree A), flatten (tree_map f t) = List.map f (flatten t).

  Fixpoint tree_forall {A} (P: A -> Prop) (tr: tree A) :=
    match tr with
    | Leaf => True
    | Node l d r => tree_forall P l /\ P d /\ tree_forall P r
    end.

  Parameter tree_exists : forall {A: Type}, (A -> Prop) -> tree A -> Prop.

  (*[0.5%]*)
  Parameter tree_exists_Leaf :
    forall (A : Type) (P : A -> Prop), ~ tree_exists P Leaf.
  (*[3%]*)
  Parameter tree_forall_exists :
    forall (A : Type) (P : A -> Prop) (tr : tree A),
      tr <> Leaf -> tree_forall P tr -> tree_exists P tr.

  (*[2%]*)
  (* Explain what tree_forall_sound means *)

  (*[3%]*)
  Parameter tree_forall_sound :
    forall (A : Type) (P : A -> Prop) (tr : tree A),
      tree_forall P tr -> forall d : A, tree_exists (fun d' : A => d' = d) tr -> P d.

  (* 2d) Binary search trees *)

  Local Open Scope Z_scope.

  Fixpoint bst (tr : tree Z) (s : Z -> Prop) :=
    match tr with
    | Leaf => forall x, not (s x) (* s is empty set *)
    | Node l d r =>
      s d /\
      bst l (fun x => s x /\ x < d) /\
      bst r (fun x => s x /\ d < x)
    end.

  (*[3%]*)
  Parameter bst_implies :
    forall (tr : tree Z) (s : Z -> Prop), bst tr s -> tree_forall s tr.

  (*[3%]*)
  Parameter bst_node_ordered :
    forall (l : tree Z) (d : Z) (r : tree Z) (s : Z -> Prop),
      bst (Node l d r) s ->
      tree_forall (fun x : Z => x < d) l /\ tree_forall (fun x : Z => d < x) r.

  (*[6%]*)
  Parameter bst_iff :
    forall (tr : tree Z) (P Q : Z -> Prop),
      bst tr P -> (forall x : Z, P x <-> Q x) -> bst tr Q.

  (*[8%]*)
  Parameter bst_strict_monotone_increasing : forall tr P Q f g,
      bst tr P ->
      left_inverse g f ->
      (forall x y, x < y <-> f x < f y) ->
      (forall x, P x <-> Q (f x)) ->
      bst (tree_map f tr) Q.

  (*[8%]*)
  Parameter bst_strict_monotone_decreasing_mirror : forall tr P Q f g,
      bst tr P ->
      left_inverse g f ->
      (forall x y, x < y <-> f x > f y) ->
      (forall x, P x <-> Q (f x)) ->
      bst (mirror (tree_map f tr)) Q.

  Fixpoint bst_member (a: Z) (tr: tree Z) : bool :=
    match tr with
    | Leaf => false
    | Node lt v rt =>
      match compare a v with
      | Lt => bst_member a lt
      | Eq => true
      | Gt => bst_member a rt
      end
    end.

  (*[5%]*)
  Parameter member_bst :
    forall (tr : tree Z) (s : Z -> Prop) (a : Z),
      bst tr s -> bst_member a tr = true <-> s a.
End S.

(* Here's a technical note on why this pset overrides a Frap tactic.
   There's no need to understand this at all.

   The "simplify" tactic provided by the Frap library is not quite suitable for this
   pset, because it does "autorewrite with core in *" (which we commented out below),
   and there's a Hint in Coq.Program.Combinators

        Hint Rewrite <- @compose_assoc : core.

   which causes "autorewrite with core in *." to have the
   same effect as

   rewrite <-? Combinators.compose_assoc.

   and apparently, rewrite does not just syntactic matching,
   but matching modulo unification, so it will replace
   our "compose" by "Basics.compose", and rewrite using
   associativity of "compose" as many times as it can.
   It's confusing to have "Basics.compose" appear in our goals,
   and rewriting with associativity is something we want to teach in this
   pset, so we redefine "simplify" to not use "autorewrite": *)
Ltac simplify ::=
  repeat (unifyTails; pose proof I); repeat match goal with
                                            | H:True |- _ => clear H
                                            end;
   repeat progress (simpl in *; intros(*; try autorewrite with core in * *); simpl_maps);
   repeat normalize_set || doSubtract.

Ltac cases E :=
  (is_var E; destruct E) ||
    match type of E with
    | sumor (sumbool _ _) _ => destruct E as [[]|]
    | {_} + {_} => destruct E
    | _ => let Heq := fresh "Heq" in
           destruct E eqn:Heq
    end;
   repeat
    match goal with
    | H:_ = left _ |- _ => clear H
    | H:_ = right _ |- _ => clear H
    | H:_ = inleft _ |- _ => clear H
    | H:_ = inright _ |- _ => clear H
    end.

(*|
TIPS: A few things that might be helpful keep in mind as you work on pset 3
===========================================================================
|*)

(*|
You can unfold "not"
====================

"~ P" in Coq stands for "not P", and is defined as "P -> False", so to prove "~ P", it sometimes helps to do "unfold not. simplify."

The propositional tactic will unfold all instances of `not` that it finds.

Behavior of simplify on fixpoints
=================================

Some students have been running into a situation where [simplify] doesn't behave as they expect. This hint will explore the behavior of [simplify] on [Fixpoint] definitions.

Here's a simple [Fixpoint] definition [always_true : Z -> Z] that deserves its name:
|*)

Fixpoint always_true (x : Z) {struct x} : bool := true.

(*|
Note that the syntax [{struct x}] is a hint to Coq that our definition structurally recurses on the [x] argument (the only argument). Of course, there isn't any recursion at all here! So indeed, every recursive call (of which there are none) passes a structurally smaller [x] argument to [always_true].

Now, suppose we try to prove the following theorem:
|*)

Theorem always_true_ok : forall x : Z,
    always_true x = true.
Proof.
  simplify. (* only introduces [x], without doing simplification *)
  Fail equality. (* Fails! *)

(*|
That's surprising, isn't it?

Here's a key fact to understanding how [simplify] works on [Fixpoint] definitions: [simplify] only reduces the application of [Fixpoint] definition when the argument on which it structurally recurses (according to Coq) is in the form of a constructor application.

That's a mouthful. A trivial way to remedy this is to use [cases] on the argument for which the fixpoint is known to be structurally recursive:
|*)

  cases x; equality.
Qed.

Local Close Scope Z_scope.

(*|
Another possible solution for our example here is to just define [always_true] as a [Definition], rather than a [Fixpoint]; then [simplify] will work as expected.

In the problem set, you may run into a [Fixpoint] that can be viewed as structurally recursive on two different arguments, and by using the "{struct}" syntax seen above, you can choose which - one may be more convenient with respect to [simplify]'s behavior as noted in the bolded statement above.

Finally, since Coq usually infers which argument a fixpoint is structurally decreasing on, you can run [Print f] for any fixpoint [f] to see which argument Coq chose.
|*)

(*|
HINTS: A few hints to help you if you get stuck on certain
       problems in Pset 3.
       Beware! Don't read further if you don't want spoilers!
=============================================================
|*)

(*|
HINT 1: Specializing function equalities
========================================

You may find it useful to prove the following lemma:

Lemma specialize_fun_eq : forall {A B: Type},
    forall (f g: A -> B), forall x,
        f = g -> f x = g x.
Admitted.
|*)

(*|
HINT 2: Main insight needed to prove invert_selfCompose
=======================================================

Do not unfold `compose` to prove invert_selfCompose.  Instead, use the following lemma:

Lemma selfCompose_succ_alt{A: Type}: forall (g: A -> A) (n: nat),
    g ∘ selfCompose g n = selfCompose g n ∘ g.
Admitted.
|*)

(*|
HINT 3: A function to build a trie with only one entry
======================================================

We found the following function helpful to define insert:

Fixpoint build_singleton {A} (k : list bool) (v : option A) : bitwise_trie A :=
  match k with
  | [] => Node Leaf v Leaf
  | x :: k' => let branch := build_singleton k' v in
               if x then Node branch None Leaf
               else Node Leaf None branch
  end.
|*)

(*|
HINT 4: Helper lemma for lookup_insert
======================================

The following lemma helps with lookup_insert:

Lemma lookup_build_singleton {A} (k : list bool) (v : option A)
  : lookup k (build_singleton k v) = v.
Admitted.
|*)

(*|
HINT 5 : Proving merge_selfCompose
================================

You may find the following lemmas helpful:

Lemma merge_id {A} : forall (t1 : bitwise_trie A),
    merge t1 t1 = t1.
Admitted.

Lemma merge_idempotent {A} : forall (t1 t2 : bitwise_trie A),
    merge t1 (merge t1 t2) = merge t1 t2.
Admitted.

|*)

(*|
HINT 6: Helper lemma for tree_map_flatten
=========================================

For tree_map_flatten, use the following intermediate lemma:

Lemma map_append : forall {A B : Type} (f : A -> B) (xs ys : list A),
    map f (xs ++ ys) = map f xs ++ map f ys.
Admitted.
|*)

(*|
HINT 7: Proving bst_implies
===========================

The following lemma is one way to prove bst_implies:

Lemma tree_forall_implies:
  forall tr (P Q: Z -> Prop),
    tree_forall P tr ->
    (forall x, P x -> Q x) ->
    tree_forall Q tr.
Admitted.
|*)


(**
CoLoR, a Coq library on rewriting and termination.
See the COPYRIGHTS and LICENSE files.

- Adam Koprowski, 2004-09-06
- William Delobel, 2005-10-07

This file provides some basic results concerning relations that were
missing in the standard library.
*)

Set Implicit Arguments.

From Coq Require Export Relations.
From Coq Require Import Max Arith Setoid Morphisms Basics.
From CoLoR Require Import LogicUtil RelUtil.

(***********************************************************************)
(** strict order *)

Section StrictOrder.

  Variables (A : Type) (R : relation A).

  Record strict_order : Prop := {
    sord_trans : transitive R;
    sord_irrefl : irreflexive R }.

  Variable so : strict_order.

  Lemma so_not_symmetric : forall a b, R a b -> R b a -> False.

  Proof.
    unfold not; intros a b Rab Rba.
    exact (sord_irrefl so (sord_trans so Rab Rba)).
  Qed.

  Variables (eq : relation A)
            (Req_compat : Proper (eq ==> eq ==> impl) R)
            (eq_Equivalence : Equivalence eq).

  Existing Instance eq_Equivalence.
  Existing Instance Req_compat.

  Lemma so_strict : forall x y, eq x y -> ~R x y.

  Proof. intros x y xy. rewrite xy. apply sord_irrefl. hyp. Qed.

End StrictOrder.

(***********************************************************************)
(** module types for setoids with decidable equality *)

Module Type SetA.
  Parameter A : Type.
End SetA.

Module Type Eqset.

  Parameter A : Type.

  Parameter eqA : relation A.
  Notation "X =A= Y" := (eqA X Y) (at level 70).

  Declare Instance eqA_Equivalence : Equivalence eqA.

  Hint Resolve (Seq_refl  A eqA eqA_Equivalence) : sets.
  Hint Resolve (Seq_trans A eqA eqA_Equivalence) : sets.
  Hint Resolve (Seq_sym   A eqA eqA_Equivalence) : sets.

End Eqset.

Module Type Eqset_dec.

  Declare Module Export Eq : Eqset.

  Parameter eqA_dec : forall x y, {x =A= y} + {~x =A= y}.

End Eqset_dec.

Module Eqset_def (A : SetA) <: Eqset.

  Definition A := A.A.

  Definition eqA := eq (A:=A).

  Instance eqA_Equivalence : Equivalence eqA.

  Proof. unfold eqA. class. Qed.

  Hint Resolve (Seq_refl  A eqA eqA_Equivalence) : sets.
  Hint Resolve (Seq_trans A eqA eqA_Equivalence) : sets.
  Hint Resolve (Seq_sym   A eqA eqA_Equivalence) : sets.

End Eqset_def.

(***********************************************************************)
(** module types for ordered setoids *)

Section Eqset_def_gtA_eqA_compat.

  Variables (A : Type) (gtA : relation A).

  Instance Eqset_def_gtA_eqA_compat : Proper (eq ==> eq ==> impl) gtA.

  Proof.
    intros x x' x_x' y y' y_y' x_y. rewrite <- x_x', <- y_y'; trivial.
  Qed.

End Eqset_def_gtA_eqA_compat.

Module Type Ord.

  Parameter A : Type.

  Declare Module Export S : Eqset with Definition A := A.

  Parameter gtA : relation A.
  Notation "X >A Y" := (gtA X Y) (at level 70).

  Declare Instance gtA_eqA_compat : Proper (eqA ==> eqA ==> impl) gtA.

  Hint Resolve gtA_eqA_compat : sets.

End Ord.

Module OrdLemmas (Export P : Ord).

  Definition ltA := transp gtA.
  Definition geA x y := ~ ltA x y.
  Definition leA x y := ~ gtA x y.
  Definition AccA := Acc ltA.

  Notation "X <A Y" := (ltA X Y) (at level 70).
  Notation "X >=A Y" := (geA X Y) (at level 70).
  Notation "X <=A Y" := (leA X Y) (at level 70).

  Hint Unfold ltA geA leA AccA : sets.

(*REMOVE?*)
  Instance gtA_morph : Proper (eqA ==> eqA ==> iff) gtA.

  Proof. intros a b ab c d cd. split; apply gtA_eqA_compat; (hyp||sym;hyp). Qed.

(*REMOVE?*)
  Instance ltA_morph : Proper (eqA ==> eqA ==> iff) ltA.

  Proof. intros a b ab c d cd. split; apply gtA_eqA_compat; (hyp||sym;hyp). Qed.

  Instance AccA_morph : Proper (eqA ==> iff) AccA.

  Proof.
    intros a b eq_ab. split.
    intro acc_a. inversion acc_a. constructor. intros.
    apply H. rewrite eq_ab. hyp.
    intros acc_b. inversion acc_b. constructor. intros.
    apply H. rewrite <- eq_ab. hyp.
  Qed.

End OrdLemmas.

Module Type Poset.

  Parameter A : Type.

  Declare Module Export O : Ord with Definition A := A.

  Parameter gtA_so : strict_order gtA.

  Hint Resolve (sord_trans gtA_so) : sets.
  Hint Resolve (sord_irrefl gtA_so) : sets.
  Hint Resolve (so_not_symmetric gtA_so) : sets.
  Hint Resolve (so_strict gtA_so gtA_eqA_compat eqA_Equivalence) : sets.

End Poset.

Module nat_ord <: Ord.

  Module natSet <: SetA.
    Definition A := nat.
    Definition eqA_dec := eq_nat_dec.
  End natSet.

  Module S := Eqset_def natSet.

  Definition A := nat.
  Definition gtA := gt.

  Instance gtA_eqA_compat : Proper (eq ==> eq ==> impl) gt.

  Proof. fo. Qed.

End nat_ord.

(***********************************************************************)
(** specification *)

Section Specif.

  Inductive sigPS2 (A : Type) (P : A -> Prop) (Q : A -> Set) : Type :=
    existPS2 : forall x, P x -> Q x -> sigPS2 (A:=A) P Q.

  Notation "{ x : A # P & Q }"
    := (sigPS2 (fun x : A => P) (fun x : A => Q)) : type_scope.

  Variables (A : Type) (P Q : A -> Prop).

  Definition proj1_sig2 (e: sig2 P Q) :=
    match e with
    | exist2 _ _ a p q => a
    end.

End Specif.

(***********************************************************************)
(** tactics *)

Ltac rewrite_lr term := apply (proj1 term).
Ltac rewrite_rl term := apply (proj2 term).

Ltac try_solve :=
   simpl in *; try (intros; solve
     [ contr
     | discr
     | auto with terms
     | tauto
     | congruence
     ]).


Require Import Metalib.Metatheory.
Require Import Coq.Program.Equality.
Require Import Strings.String.
Require Import Program.Tactics.
Require Import Lia.
Require Import Language Tactical.
Require Import Toplike.
Require Import Splitable.

Set Printing Parentheses.

(** * Definition *)

Inductive sub : type -> type -> Prop :=
| Sub_Int :
    sub Int Int
| Sub_Top : forall A B,
    ordinary B -> toplike B ->
    sub A B
| Sub_Arr : forall A B C D,
    sub C A -> sub B D ->
    ordinary D ->
    sub (Arr A B) (Arr C D)
| Sub_Rcd : forall A B l,
    ordinary B ->
    sub A B ->
    sub (Rcd l A) (Rcd l B)
| Sub_And : forall A B B1 B2,
    splitable B B1 B2 ->
    sub A B1 -> sub A B2 ->
    sub A B
| Sub_And_L : forall A B C,
    sub A C -> ordinary C ->
    sub (And A B) C
| Sub_And_R : forall A B C,
    sub B C -> ordinary C ->
    sub (And A B) C.

Hint Constructors sub : core.

Notation "A <: B" := (sub A B) (at level 40).

(** * Generlization *)

(** generlization of [Sub_Arrow] *)

Lemma sub_arrow :
  forall A B C D,
    sub B D ->
    sub C A ->
    sub (Arr A B) (Arr C D).
Proof.
  introv H. dependent induction H; eauto.
Qed.

(** generlization of [Sub_Rcd] *)

Lemma sub_record :
  forall l A B,
    sub A B ->
    sub (Rcd l A) (Rcd l B).
Proof.
  introv H. dependent induction H; eauto.
Qed.

(** generlization of [Sub_And_L] *)

Lemma sub_and_l :
  forall A B C,
    sub A C -> sub (And A B) C.
Proof.
  introv H.
  dependent induction H; eauto.
Qed.

(** generlization of [Sub_And_R] *)

Lemma sub_and_r :
  forall A B C,
    sub B C -> sub (And A B) C.
Proof.
  introv H.
  dependent induction H; eauto.
Qed.

(** add it to local and global hint base **)

Hint Resolve sub_arrow : core.
Hint Resolve sub_record : core.
Hint Resolve sub_and_l : core.
Hint Resolve sub_and_r : core.

(** * Reflexivity *)

Lemma sub_reflexivity:
  forall A,
    sub A A.
Proof.
  dependent induction A; eauto.
Qed.

Hint Resolve sub_reflexivity : core.

(** * Subtyping & Splitable *)

Lemma sub_splitable_l :
  forall A A1 A2,
    splitable A A1 A2 -> sub A A1.
Proof.
  introv H. dependent induction H; eauto.
Qed.

Lemma sub_splitable_r :
  forall A A1 A2,
    splitable A A1 A2 -> sub A A2.
Proof.
  introv H. dependent induction H; eauto.
Qed.

Hint Resolve sub_splitable_l : subtyping.
Hint Resolve sub_splitable_r : subtyping.

Lemma sub_splitable:
  forall A A1 A2,
    splitable A A1 A2 -> sub A (And A1 A2) /\ sub (And A1 A2) A.
Proof.
  introv H. split.
  - eapply Sub_And; eauto with subtyping.
  - dependent induction H; eauto with subtyping.
Qed.

Hint Resolve sub_splitable : subtyping.

(** * Splitable & Toplike *)

Lemma splitable_toplike1:
  forall A A1 A2,
    splitable A A1 A2 -> toplike A1 -> toplike A2 -> toplike A.
Proof.
  introv Spl Tl1 Tl2.
  dependent induction Spl; eauto.
Qed.

Lemma splitable_toplike2 :
  forall A A1 A2,
    splitable A A1 A2 -> toplike A -> toplike A1 /\ toplike A2.
Proof.
  introv Spl Tl. induction Spl.
  - dependent destruction Tl; intuition.
  - dependent destruction Tl; intuition.
  - dependent destruction Tl; intuition.
Qed.

Lemma splitable_not_toplike :
  forall A A1 A2,
    ~ toplike A -> splitable A A1 A2 ->
    ~ toplike A1 \/ ~ toplike A2.
Proof.
  introv nTl Spl. gen A1 A2.
  induction A; intros; eauto.
  - dependent destruction Spl.
    destruct (toplike_decidable A2); eauto.
    pose proof (IHA2 H _ _ Spl) as nTls.
    destruct nTls.
    + left. intros Contra. contra_toplike.
    + right. intros Contra. contra_toplike.
  - dependent destruction Spl.
    destruct (toplike_decidable A1); eauto.
  - dependent induction Spl.
    destruct (toplike_decidable A); eauto.
    pose proof (IHA H _ _ Spl) as nTls.
    destruct nTls.
    + left. intros Contra. contra_toplike.
    + right. intros Contra. contra_toplike.
Qed.

(** * Subtyping & Toplike (1) *)

Lemma sub_toplike:
  forall A B,
    toplike A -> sub A B -> toplike B.
Proof.
  introv Tl Sub.
  induction Sub; eauto with subtyping.
  - eapply splitable_toplike1; eauto.
  - dependent destruction Tl; eauto.
  - dependent destruction Tl; eauto.
Qed.

Hint Resolve sub_toplike : subtyping.
Hint Resolve sub_toplike : core.

Lemma sub_not_toplike :
  forall A B,
    ~ toplike B -> sub A B -> ~ toplike A.
Proof.
  introv Ntl Sub.
  intros Contra.
  pose proof (sub_toplike _ _ Contra Sub).
  contradiction.
Qed.

(** * Inversion Lemmas *)

Lemma sub_inv_splitable_l :
  forall A B A1 A2,
    sub A B -> splitable A A1 A2 -> ordinary B -> sub A1 B \/ sub A2 B.
Proof.
  introv Sub Spl Ord. gen A1 A2.
  induction Sub; eauto; intros.
  - dependent destruction Spl.
    dependent destruction Ord.
    pose proof (IHSub2 H _ _ Spl) as IH.
    destruct IH; eauto with subtyping.
  - dependent destruction Spl.
    dependent destruction Ord.
    pose proof (IHSub Ord _ _ Spl) as IH.
    destruct IH; eauto with subtyping.
  - dependent destruction Spl.
    left. assumption.
  - dependent destruction Spl.
    right. assumption.
Qed.

Lemma sub_inv_splitable_r :
  forall A B B1 B2,
    sub A B -> splitable B B1 B2 -> sub A B1 /\ sub A B2.
Proof.
  introv Sub Spl.
  dependent destruction Sub; eauto with subtyping.
  subst_splitable; intuition.
Qed.

Lemma sub_inv_int_arrow :
  forall A B,
    sub Int (Arr A B) -> ordinary B -> toplike B.
Proof.
  introv Sub Ord.
  dependent destruction Sub; eauto.
Qed.

Lemma sub_inv_int :
  forall A,
    ~ toplike A ->
    sub Int A ->
    ordinary A ->
    A = Int.
Proof.
  introv Ntl Sub Ord.
  dependent destruction Sub; eauto.
Qed.

Lemma sub_inv_arrow_arrow :
  forall A B C,
    ~ toplike C ->
    ordinary C ->
    sub (Arr A B) C ->
    exists D E, C = (Arr D E) /\ sub D A /\ sub B E.
Proof.
  introv nTl Ord Sub.
  dependent destruction Sub; eauto.
Qed.

(** * Proper Types *)

(** ** Definition *)

Inductive proper : type -> Prop :=
| Pr_Int : proper Int
| Pr_Top : proper Top
| Pr_Arr : forall A B,
    ordinary B ->
    proper A -> proper B ->
    proper (Arr A B)
| Pr_Rcd : forall l A,
    ordinary A ->
    proper A ->
    proper (Rcd l A)
| Pr_Spl : forall A A1 A2,
    splitable A A1 A2 ->
    proper A1 -> proper A2 ->
    proper A.

Hint Constructors proper : core.

(** ** Completeness *)

Lemma proper_arrow :
  forall A B,
    proper A -> proper B ->
    proper (Arr A B).
Proof.
  introv Pr_A Pr_B.
  gen A.
  induction Pr_B; eauto.
Qed.

Lemma proper_record :
  forall l A,
    proper A ->
    proper (Rcd l A).
Proof.
  introv Pr_A.
  induction Pr_A; eauto.
Qed.

Lemma proper_complete:
  forall (A : type), proper A.
Proof.
  induction A; eauto.
  eapply proper_arrow; eauto.
  eapply proper_record; eauto.
Qed.

(** We build a new induction principle for [type] *)

(** ** Proper Induction Principle *)

Ltac proper_ind A := assert (Pr: proper A)
    by apply (proper_complete A); induction Pr.

(** * Transitivity *)

Lemma sub_transitivity:
  forall A B C,
    sub A B -> sub B C -> sub A C.
Proof.
  introv Sub1 Sub2.
  gen A C.
  proper_ind B; intros.
  - dependent induction Sub2; eauto.
  - dependent induction Sub2; eauto.
  - dependent induction Sub2; eauto.
    clear IHSub2_1 IHSub2_2.
    dependent induction Sub1; eauto with subtyping.
  - dependent induction Sub2; eauto.
    clear IHSub2.
    dependent induction Sub1; eauto with subtyping.
  - gen A A1.
    proper_ind C; introv Sub1 Sub2 Spl IPr IH; eauto with subtyping.
    + eapply sub_inv_splitable_r in Sub1; eauto. destruct Sub1.
      eapply sub_inv_splitable_l in Sub2; eauto. intuition.
    + eapply sub_inv_splitable_r in Sub1; eauto. destruct Sub1.
      eapply sub_inv_splitable_l in Sub2; eauto. intuition.
    + eapply sub_inv_splitable_r in Sub1; eauto. destruct Sub1.
      eapply sub_inv_splitable_l in Sub2; eauto. intuition.
    + eapply sub_inv_splitable_r in Sub2; eauto.
      destruct Sub2; eauto.
Qed.

(** * Subtyping & Toplike (2) *)

Lemma sub_toplike_super :
  forall A,
    toplike A -> forall B, sub B A.
Proof.
  introv Tl.
  proper_ind A; eauto.
  pose proof (splitable_toplike2 _ _ _ H Tl) as Spl_Tl.
  destruct Spl_Tl; eauto.
Qed.

(** * Decidablility *)

(** subtyping is decidable, refer https://github.com/andongfan/CP-Foundations/blob/main/fiplus/coq/Subtyping.v#L1214 *)
Axiom dec_sub : forall A B, sumbool (sub A B) (not (sub A B)).


(* Contribution to the Coq Library   V6.3 (July 1999)                    *)

(****************************************************************************)
(*                                                                          *)
(*                          Constructive Geometry                           *)
(*                             according to                                 *)
(*                            Jan von Plato                                 *)
(*                                                                          *)
(*                               Coq V5.10                                  *)
(*									    *)
(*			        Gilles Kahn 				    *)
(*				   INRIA                                    *)
(*		              Sophia-Antipolis		 	            *)
(*									    *)
(*                                                                          *)
(* Acknowledgments: This work started in Turin in May 95 with Yves Bertot.  *)
(* Thanks to the Newton Institute for providing an exceptional work         *)
(* environment in Summer 1995 so that I could complete this.                *)
(****************************************************************************)

(****************************************************************************)
(*                                part2.v                                   *)
(****************************************************************************)
Require Import basis.
Require Import part1.

Theorem thm4_1a :
 forall (x : Segment) (l : Line),
 DiLn l (ln x) -> Apart (origin x) l \/ Apart (extremity x) l.
Proof.
intros x l.
generalize (inc_ln2 x); generalize (inc_ln1 x).
unfold Incident in |- *.
generalize (el_ax x l (ln x)).
tauto.
Qed.

Theorem thm4_1b :
 forall (x : Segment) (l : Line),
 Apart (origin x) l \/ Apart (extremity x) l -> DiLn l (ln x).
Proof.
intros x l.
generalize (inc_ln2 x); generalize (inc_ln1 x).
unfold Incident in |- *.
intros H' H'0 H'1; elim H'1; intro H'2; clear H'1.
elim (cmp_apt_diln (origin x) l (ln x)); tauto.
elim (cmp_apt_diln (extremity x) l (ln x)); tauto.
Qed.
Hint Resolve thm4_1a thm4_1b.

Theorem thm4_1c :
 forall (x : Twolines) (a : Point),
 DiPt a (pt x) -> Apart a (line1 x) \/ Apart a (line2 x).
Proof.
intros x a.
generalize (inc_pt2 x); generalize (inc_pt1 x).
unfold Incident in |- *.
intros H' H'0 H'1.
generalize (el_ax (Seg a (pt x) H'1) (line1 x) (line2 x)); simpl in |- *.
cut (DiLn (line1 x) (line2 x)).
tauto.
elim x; auto.
Qed.

Theorem thm4_1d :
 forall (x : Twolines) (a : Point),
 Apart a (line1 x) \/ Apart a (line2 x) -> DiPt a (pt x).
Proof.
intros x a.
generalize (inc_pt2 x); generalize (inc_pt1 x).
unfold Incident in |- *.
intros H' H'0 H'1; elim H'1; intro H'2; clear H'1.
generalize (cmp_apt_dipt a (pt x) (line1 x)); tauto.
generalize (cmp_apt_dipt a (pt x) (line2 x)); tauto.
Qed.

Theorem Symmetry_of_Apart :
 forall x y : Segment,
 Apart (origin x) (ln y) \/ Apart (extremity x) (ln y) ->
 Apart (origin y) (ln x) \/ Apart (extremity y) (ln x).
intros x y H'.
apply thm4_1a.
apply sym_DiLn; auto.
Qed.

Theorem thm4_3a :
 forall (x : Segment) (c : Point), Apart c (ln x) -> DiPt c (origin x).
Proof.
intros x c H'.
elim (cmp_apt_dipt c (origin x) (ln x)); trivial.
intro H0; elim (inc_ln1 x); trivial.
Qed.

Theorem thm4_3b :
 forall (x : Segment) (c : Point), Apart c (ln x) -> DiPt c (extremity x).
Proof.
intros x c H'.
elim (cmp_apt_dipt c (extremity x) (ln x)); trivial.
intro H0; elim (inc_ln2 x); trivial.
Qed.

Definition Side1 : Triangle -> Segment.
Proof.
intro H'; elim H'; clear H'.
intros summit base H'.
apply (Seg summit (origin base)).
apply thm4_3a; trivial.
Defined.

Definition Side2 : Triangle -> Segment.
Proof.
intro H'; elim H'; clear H'.
intros summit base H'.
apply (Seg summit (extremity base)).
apply thm4_3b; trivial.
Defined.

Theorem auxs1 : forall t : Triangle, origin (base t) = extremity (Side1 t).
Proof.
intro t; elim t; auto.
Qed.

Theorem auxs2 : forall t : Triangle, extremity (base t) = extremity (Side2 t).
Proof.
intro t; elim t; auto.
Qed.

Theorem auxs3 : forall t : Triangle, summit t = origin (Side1 t).
Proof.
intro t; elim t; auto.
Qed.

Theorem auxs4 : forall t : Triangle, summit t = origin (Side2 t).
Proof.
intro t; elim t; auto.
Qed.

Theorem thm4_3c : forall t : Triangle, DiLn (ln (base t)) (ln (Side1 t)).
Proof.
intro H'; elim H'; clear H'.
intros summit base Tri_cond.
elim (cmp_apt_diln summit (ln base) (ln (Side1 (Tri summit base Tri_cond))));
 auto.
Qed.

Theorem thm4_3d : forall t : Triangle, DiLn (ln (base t)) (ln (Side2 t)).
Proof.
intro H'; elim H'; clear H'.
intros summit base Tri_cond.
elim (cmp_apt_diln summit (ln base) (ln (Side2 (Tri summit base Tri_cond))));
 auto.
Qed.

Hint Resolve thm4_3c thm4_3d.


(* Gabriel Braun April 2013 *)

Require Export GeoCoq.Tarski_dev.Ch13_3_angles.

Ltac anga_instance_o a A B P C :=
        assert(tempo_anga:= anga_const_o a A B P);
        match goal with
           |H: Q_CongA_Acute a |-  _ => assert(tempo_H:= H); apply tempo_anga in tempo_H; ex_elim tempo_H C
        end;
        clear tempo_anga.

Section Cosinus.

Context `{TnEQD:Tarski_neutral_dimensionless_with_decidable_point_equality}.

(************************************* cos *****************************)

Lemma l13_6 : forall a lc ld l, Lcos lc l a -> Lcos ld l a -> EqL lc ld.
Proof.
    intros.
    unfold Lcos in *.
    spliter.
    ex_and H6 X1.
    ex_and H7 Y1.
    ex_and H6 Z1.
    ex_and H3 X2.
    ex_and H10 Y2.
    ex_and H3 Z2.
    clean_duplicated_hyps.
    assert(Len X1 Z1 l).
      split; auto.
    assert(Len X2 Z2 l).
      split; auto.
    assert(Cong X1 Z1 X2 Z2).
      eapply (is_len_cong _ _ _ _ l); auto.
    assert(Ang_Acute Y1 X1 Z1 a).
      split; auto.
    assert(Ang_Acute Y2 X2 Z2 a).
      split; auto.
    assert(CongA Y1 X1 Z1 Y2 X2 Z2).
      apply (is_anga_conga _ _ _ _ _ _ a); split; auto.
    assert(Len X1 Y1 lc).
      split; auto.
    assert(Len X2 Y2 ld).
      split; auto.
    induction(eq_dec_points Z1 Y1).
      subst Z1.
      assert(Out X2 Y2 Z2).
        apply (eq_conga_out Y1 X1); auto.
      assert(Y2 = Z2).
        assert(Z2 = Y2 \/ X2 = Y2).
          apply l8_9.
            auto.
          apply out_col in H19.
          Col.
        induction H20.
          auto.
        unfold Out in H19.
        spliter.
        subst Y2.
        tauto.
      subst Z2.
      assert(EqL l lc).
        apply ex_eql.
        exists X1.
        exists Y1.
        split; auto.
      assert(EqL l ld).
        apply ex_eql.
        exists X2.
        exists Y2.
        split; auto.
     transitivity l;auto.
     symmetry; auto.
    assert(Z2 <> Y2).
      intro.
      subst Z2.
      assert(Out X1 Y1 Z1).
        apply (eq_conga_out Y2 X2).
        apply conga_sym.
        auto.
      assert(Y1 = Z1).
        assert(Z1 = Y1 \/ X1 = Y1).
          apply l8_9.
            auto.
          apply out_col in H20.
          Col.
        induction H21.
          auto.
        subst Y1.
        unfold Out in H20.
        spliter.
        tauto.
      subst Z1.
      tauto.
    apply conga_distinct in H16.
    spliter.
    assert(CongA X1 Y1 Z1 X2 Y2 Z2).
      apply l11_16; Perp; auto.
    assert(~Col Z1 X1 Y1).
      intro.
      assert(X1 = Y1 \/ Z1 = Y1).
        apply l8_9.
          Perp.
        Col.
      induction H27.
        subst Y1.
        tauto.
      contradiction.
    apply conga_comm in H16.
    apply cong_commutativity in H13.
    assert(HH:=l11_50_2 Z1 X1 Y1 Z2 X2 Y2 H26 H25 H16 H13).
    spliter.
    apply ex_eql.
    exists X1.
    exists Y1.
    split.
      auto.
    eapply is_len_cong_is_len.
      apply H18.
    Cong.
Qed.

Lemma null_lcos_eql : forall lp l a, Lcos lp l a -> Q_CongA_Null_Acute a -> EqL l lp.
Proof.
    intros.
    unfold Lcos in H.
    spliter.
    ex_and H3 A.
    ex_and H4 B.
    ex_and H3 C.
    unfold Q_CongA_Null_Acute in H0.
    spliter.
    assert(HH:= H7 B A C H6).
    assert(Col A B C) by (apply out_col;auto).
    assert(Col C B A) by Col.
    assert(HQ:= l8_9 C B A H3 H9).
    induction HQ.
      subst C.
      apply (all_eql A B).
        split; auto.
      split; auto.
    subst B.
    exfalso.
    unfold Out in HH.
    tauto.
Qed.

Lemma eql_lcos_null : forall l lp a, Lcos l lp a -> EqL l lp -> Q_CongA_Null_Acute a.
Proof.
    intros.
    unfold Lcos in H.
    spliter.
    ex_and H3 B.
    ex_and H4 A.
    ex_and H3 C.
    assert(forall A0 B0 : Tpoint, l A0 B0 <-> lp A0 B0).
      apply H0; auto.
    assert(HP:= (H7 B A)).
    assert(HQ:= (H7 B C)).
    destruct HP.
    destruct HQ.
    assert(l B C).
      apply H11.
      auto.
    assert(lp B A).
      apply H8.
      auto.
    clear H7 H8 H9 H10 H11.
    assert(Cong B A B C).
      apply (lg_cong l); auto.
    unfold Per in H3.
    ex_and H3 B'.
    assert(HH:= anga_distinct a A B C H2 H6).
    spliter.
    assert(A = C).
      eapply (l4_18 B B').
        intro.
        subst B'.
        apply l7_3 in H3.
        contradiction.
        unfold Midpoint in H3; assert(HH:= midpoint_col).
        spliter.
        apply bet_col in H3.
        Col.
        auto.
      unfold Midpoint in H3.
      spliter.
      eapply cong_transitivity.
        apply cong_symmetry.
        apply cong_commutativity.
        apply H11.
      eapply cong_transitivity.
        apply cong_commutativity.
        apply H7.
      Cong.
    subst C.
    unfold Q_CongA_Null_Acute.
    split.
      auto.
    intros A0 B0 C0 HP.
    apply (eq_conga_out A B).
    apply (anga_conga a); auto.
Qed.

Lemma lcos_lg_not_null: forall l lp a, Lcos l lp a -> ~ Q_Cong_Null l /\ ~ Q_Cong_Null lp.
Proof.
    intros.
    unfold Lcos in H.
    spliter.
    ex_and H2 A.
    ex_and H3 B.
    ex_and H2 C.
    assert(HH:= anga_distinct a B A C H1 H5).
    spliter.
    unfold Q_Cong_Null.
    split; intro; spliter; ex_and H9 X.
      assert (Cong A B X X) by (apply (lg_cong l); auto).
      treat_equalities;intuition.
    assert(Cong A C X X) by (apply (lg_cong lp); auto).
    treat_equalities;intuition.
Qed.

Lemma perp_acute_out : forall A B C C', Acute A B C -> Perp A B C C' -> Col A B C' -> Out B A C'.
Proof.
    intros.
    apply l6_6.
    apply acute_col_perp__out with C.
      apply acute_sym.
      assumption.
      Col.
      Perp.
Qed.

End Cosinus.

Require Import Morphisms.

Section Cosinus2.

Context `{TnEQD:Tarski_neutral_dimensionless_with_decidable_point_equality}.

Lemma perp_out__acute : forall A B C C', Perp A B C C' -> Col A B C' -> (Acute A B C <-> Out B A C').
Proof.
    intros.
    split.
      intro.
      apply (perp_acute_out _ _ C); auto.
    intro.
    apply (perp_out_acute _ _ C C'); auto.
Qed.

Lemma obtuse_not_acute : forall A B C, Obtuse A B C -> ~ Acute A B C.
Proof.
    intros.
    intro.
    unfold Obtuse in H.
    unfold Acute in H0.
    ex_and H A0.
    ex_and H1 B0.
    ex_and H C0.
    ex_and H0 A1.
    ex_and H2 B1.
    ex_and H0 C1.
    assert(A0 <> B0 /\ C0 <> B0 /\ A1 <> B1 /\ C1 <> B1 /\ A <> B /\ C <> B).
      unfold LtA in *.
      unfold LeA in *.
      spliter.
      ex_and H1 P0.
      ex_and H2 P.
      unfold InAngle in H2.
      unfold CongA in H5 .
      unfold CongA in H6 .
      spliter.
      repeat split; auto.
    spliter.
    assert(CongA A0 B0 C0 A1 B1 C1).
      apply l11_16; auto.
    assert(LtA A1 B1 C1 A B C).
      apply (conga_preserves_lta A0 B0 C0 A B C).
        auto.
        apply conga_refl; auto.
      assumption.
    assert(HH:=not_and_lta A B C A1 B1 C1).
    apply HH.
    split; auto.
Qed.

Lemma acute_not_obtuse : forall A B C, Acute A B C -> ~ Obtuse A B C.
Proof.
    intros.
    intro.
    apply obtuse_not_acute in H0.
    contradiction.
Qed.

Lemma perp_obtuse_bet : forall A B C C', Perp A B C C' -> Col A B C' -> Obtuse A B C -> Bet A B C'.
Proof.
    intros.
    assert(HH:= H1).
    unfold Obtuse in HH.
    ex_and HH A0.
    ex_and H2 B0.
    ex_and H3 C0.
    assert(A0 <> B0 /\ C0 <> B0 /\ A <> B /\ C <> B).
      unfold LtA in H3.
      spliter.
      unfold LeA in H3.
      ex_and H3 P.
      unfold CongA in H5.
      spliter.
      repeat split; auto.
      intro.
      subst C.
      apply perp_comm in H.
      apply perp_not_col in H.
      apply H.
      Col.
    spliter.
    assert(B <> C').
      intro.
      subst C'.
      assert(Per A B C).
        apply perp_in_per.
        apply perp_in_comm.
        apply perp_perp_in.
        Perp.
      assert(CongA A0 B0 C0 A B C).
        apply l11_16; auto.
      unfold LtA in H3.
      spliter.
      unfold LeA in H3.
      contradiction.
    induction H0.
      auto.
    assert(Out B A C').
      unfold Out.
      repeat split; auto.
      induction H0.
        right.
        auto.
      left.
      Between.
    eapply (perp_out_acute _ _ C) in H9.
      apply obtuse_not_acute in H1.
      contradiction.
      auto.
Qed.

Lemma lcos_const0 : forall l lp a, Lcos lp l a -> Q_CongA_Null_Acute a ->
 exists A, exists B, exists C, l A B /\ lp B C /\ a A B C.
Proof.
    intros.
    assert(HH:=H).
    unfold Lcos in HH.
    spliter.
    ex_and H4 A.
    ex_and H5 B.
    ex_and H4 C.
    exists C.
    exists A.
    exists B.
    repeat split.
      apply lg_sym; auto.
      auto.
    apply anga_sym; auto.
Qed.

Lemma lcos_const1 : forall l lp a P, Lcos lp l a -> ~ Q_CongA_Null_Acute a ->
 exists A, exists B, exists C, ~Col A B P /\ OS A B C P /\ l A B /\ lp B C /\ a A B C.
Proof.
    intros.
    assert(HH:=H).
    unfold Lcos in HH.
    spliter.
    assert(HH:= (lcos_lg_not_null lp l a H)).
    spliter.
    lg_instance_not_col l P A B.
    exists A.
    exists B.
    assert(HH:=anga_const_o a A B P H8 H0 H3).
    ex_and HH C'.
    assert(A <> B /\ B <> C').
      assert(HP:= anga_distinct a A B C' H3 H9).
      spliter.
      auto.
    spliter.
    assert(HH:=ex_point_lg_out lp B C' H12 H1 H5).
    ex_and HH C.
    exists C.
    repeat split; auto.
      assert(~ Col A B C').
        unfold OS in H10.
        ex_and H10 D.
        unfold TS in H10.
        spliter.
        intro.
        apply H10.
        Col.
      assert(HP:=out_one_side_1 A B C' C B H15).
      eapply (one_side_transitivity _ _ _ C').
        apply one_side_symmetry.
        apply HP.
          Col.
        apply l6_6.
        auto.
      auto.
    apply (anga_out_anga a A B C'); auto.
      apply out_trivial.
      auto.
    apply l6_6.
    auto.
Qed.

Lemma lcos_const : forall lp l a, Lcos lp l a ->
 exists A, exists B, exists C, lp A B /\ l B C /\ a A B C.
Proof.
    intros.
    unfold Lcos in H.
    spliter.
    ex_and H2 A.
    ex_and H3 B.
    ex_and H2 C.
    exists B.
    exists A.
    exists C.
    repeat split; auto.
    apply lg_sym; auto.
Qed.

Lemma lcos_lg_distincts : forall lp l a A B C, Lcos lp l a -> l A B -> lp B C -> a A B C -> A <> B /\ C <> B.
Proof.
    intros.
    assert(HH:= lcos_lg_not_null lp l a H).
    spliter.
    unfold Q_Cong_Null in *.
    split.
      intro.
      subst B.
      apply H4.
      unfold Lcos in H.
      split.
        tauto.
      exists A.
      auto.
    intro.
    subst C.
    apply H3.
    unfold Lcos in H.
    split.
      tauto.
    exists B.
    auto.
Qed.

Lemma lcos_const_a : forall lp l a B, Lcos lp l a -> exists A, exists C, l A B /\ lp B C /\ a A B C.
Proof.
    intros.
    assert(HH:=H).
    unfold Lcos in HH.
    spliter.
    clear H3.
    assert(HH:= ex_point_lg l B H1).
    ex_and HH A.
    assert(l A B).
      apply lg_sym; auto.
    exists A.
    assert(HH:= lcos_lg_not_null lp l a H).
    spliter.
    assert(A <> B).
      intro.
      subst A.
      apply H6.
      unfold Q_Cong_Null.
      split.
        auto.
      exists B.
      auto.
    assert(HH:= anga_const a A B H2 H7).
    ex_and HH C'.
    assert(HH:= anga_distincts a A B C' H2 H8).
    spliter.
    assert(B <> C'); auto.
    assert(HH:= ex_point_lg_out lp B C' H11 H0 H5).
    ex_and HH C.
    exists C.
    repeat split; auto.
    apply (anga_out_anga a A B C' A C); auto.
      apply out_trivial.
      auto.
    apply l6_6.
    auto.
Qed.

Lemma lcos_const_ab : forall lp l a B A, Lcos lp l a -> l A B -> exists C, lp B C /\ a A B C.
Proof.
    intros.
    assert(HH:=H).
    unfold Lcos in HH.
    spliter.
    clear H4.
    assert(HH:= lcos_lg_not_null lp l a H).
    spliter.
    assert(A <> B).
      intro.
      subst A.
      apply H5.
      unfold Q_Cong_Null.
      split.
        auto.
      exists B.
      auto.
    assert(HH:= anga_const a A B H3 H6).
    ex_and HH C'.
    assert(HH:= anga_distincts a A B C' H3 H7).
    spliter.
    assert(B <> C'); auto.
    assert(HH:= ex_point_lg_out lp B C' H10 H1 H4).
    ex_and HH C.
    exists C.
    repeat split; auto.
    apply (anga_out_anga a A B C' A C); auto.
      apply out_trivial.
      auto.
    apply l6_6.
    auto.
Qed.

Lemma lcos_const_cb : forall lp l a B C, Lcos lp l a -> lp B C -> exists A, l A B /\ a A B C.
Proof.
    intros.
    assert(HH:=H).
    unfold Lcos in HH.
    spliter.
    clear H4.
    assert(HH:= lcos_lg_not_null lp l a H).
    spliter.
    assert(C <> B).
      intro.
      subst C.
      apply H4.
      unfold Q_Cong_Null.
      split.
        auto.
      exists B.
      auto.
    assert(HH:= anga_const a C B H3 H6).
    ex_and HH A'.
    assert(HH:= anga_distincts a C B A' H3 H7).
    spliter.
    assert(B <> A'); auto.
    assert(HH:= ex_point_lg_out l B A' H10 H2 H5).
    ex_and HH A.
    exists A.
    split.
      apply lg_sym; auto.
    apply(anga_out_anga a A' B C); auto.
      apply anga_sym; auto.
      apply l6_6.
      auto.
    apply out_trivial.
    auto.
Qed.

Lemma lcos_lg_anga : forall l lp a, Lcos lp l a -> Lcos lp l a /\ Q_Cong l /\ Q_Cong lp /\ Q_CongA_Acute a.
Proof.
    intros.
    split.
      auto.
    unfold Lcos in H.
    tauto.
Qed.

Lemma lcos_eql_lcos : forall lp1 l1 lp2 l2 a, EqL lp1 lp2 -> EqL l1 l2 -> Lcos lp1 l1 a -> Lcos lp2 l2 a.
Proof.
    intros.
    unfold Lcos in *.
    spliter.
    ex_and H4 A.
    ex_and H5 B.
    ex_and H4 C.

    assert(HH:=lg_eql_lg l1 l2 H2 H0).
    assert(HP:=lg_eql_lg lp1 lp2 H1 H).
    repeat split; auto.
    exists A.
    exists B.
    exists C.
    unfold EqL in *.
    spliter.
    repeat split; auto.
      apply H.
      auto.
    apply H0; auto.
Qed.

Global Instance lcos_morphism :
 Proper (EqL ==> EqL ==> eq ==> iff) Lcos.
Proof.
unfold Proper.
split.
 - rewrite H1.
   intro.
   eauto using lcos_eql_lcos.
 - intro.
   rewrite H1.
   eapply lcos_eql_lcos with y y0;
   try symmetry;assumption.
Qed.

Lemma lcos_not_lg_null : forall lp l a, Lcos lp l a -> ~ Q_Cong_Null lp.
Proof.
    intros.
    intro.
    unfold Q_Cong_Null in H0.
    spliter.
    unfold Lcos in H.
    spliter.
    ex_and H4 B.
    ex_and H5 A.
    ex_and H4 C.
    ex_and H1 P.
    unfold Q_Cong in H0.
    ex_and H0 X.
    ex_and H1 Y.
    assert(HH:= (H0 B A)).
    destruct HH.
    assert(HH:= (H0 P P)).
    destruct HH.
    apply H11 in H8.
    apply H9 in H5.
    assert(Cong B A P P).
      apply (cong_transitivity _ _ X Y); Cong.
    assert(A = B).
      eapply (cong_identity _ _ P).
      Cong.
    assert(HH:=anga_distincts a A B C H3 H7).
    spliter.
    contradiction.
Qed.

Lemma lcos_const_o : forall lp l a A B P, ~ Col A B P -> ~ Q_CongA_Null_Acute a -> Q_Cong l -> Q_Cong lp ->
  Q_CongA_Acute a -> l A B -> Lcos lp l a ->
  exists C, OS A B C P /\ a A B C /\ lp B C.
Proof.
    intros.
    assert(HH:= anga_const_o a A B P H H0 H3).
    ex_and HH C'.
    assert(A <> B /\ C' <> B).
      apply (anga_distincts a); auto.
    spliter.
    assert(HH:= lcos_not_lg_null lp l a H5).
    assert (B <> C').
      intro.
      apply H9.
      auto.
    assert(HP:=lg_exists C' B).
    ex_and HP lc'.
    assert(HQ:=anga_not_lg_null a l lc' A B C' H1 H11 H3 H4 H12 H6).
    spliter.
    assert(HR:= ex_point_lg_out lp B C' H10 H2 HH).
    ex_and HR C.
    exists C.
    split.
      apply invert_one_side.
      apply one_side_symmetry.
      apply (out_out_one_side _ _ _ C').
        apply invert_one_side.
        apply one_side_symmetry.
        auto.
      apply l6_6.
      auto.
    split.
      eapply (anga_out_anga a A B C'); auto.
        apply out_trivial.
        auto.
      apply l6_6.
      auto.
    auto.
Qed.

Lemma flat_not_acute : forall A B C, Bet A B C -> ~ Acute A B C.
Proof.
    intros.
    intro.
    unfold Acute in H0.
    ex_and H0 A'.
    ex_and H1 B'.
    ex_and H0 C'.
    unfold LtA in H1.
    spliter.
    unfold LeA in H1.
    ex_and H1 P'.
    unfold InAngle in H1.
    spliter.
    ex_and H6 X.
    apply conga_distinct in H3.
    spliter.
    assert(A <> C).
      intro.
      subst C.
      apply between_identity in H.
      contradiction.
    induction H7.
      subst X.
      apply H2.
      apply conga_line; auto.
    assert(CongA A B C A' B' X).
      apply (l11_10 A B C A' B' P'); auto; apply out_trivial; auto.
    apply H2.
    assert(Bet A' B' X).
      apply (bet_conga__bet A B C); auto.
    apply conga_line; auto.
    apply (between_exchange4 _ _ X); auto.
Qed.

Lemma acute_comp_not_acute : forall A B C D, Bet A B C -> Acute A B D -> ~ Acute C B D.
Proof.
    intros.
    intro.
    induction(col_dec A C D).
      induction H2.
        assert(Bet A B D).
          eBetween.
        assert(HH:= flat_not_acute A B D H3).
        contradiction.
      induction H2.
        assert(Bet A B D \/ Bet A D B).
          apply (l5_3 A B D C).
            auto.
          Between.
        induction H3.
          assert(HH:= flat_not_acute A B D H3).
          contradiction.
        assert(Bet C B D).
          eBetween.
        assert(HH:= flat_not_acute C B D H4).
        contradiction.
      assert(Bet C B D).
        eBetween.
      assert(HH:= flat_not_acute C B D H3).
      contradiction.
    unfold Acute in *.
    ex_and H0 A0.
    ex_and H3 B0.
    ex_and H0 C0.
    ex_and H1 A1.
    ex_and H4 B1.
    ex_and H1 C1.
    assert (Hd := H3).
    assert (Hd' := H4).
    apply lta_distincts in Hd.
    apply lta_distincts in Hd'.
    spliter.
    assert(HH:=l11_16 A0 B0 C0 A1 B1 C1 H0 H12 H13 H1 H7 H8).
    assert(LtA C B D A0 B0 C0).
      eapply(conga_preserves_lta C B D A1 B1 C1).
        apply conga_refl; auto.
        apply conga_sym.
        auto.
      auto.
    clear H4.
    assert(A <> C).
      intro.
      subst C.
      apply between_identity in H.
      contradiction.
    assert(Col A C B).
      apply bet_col in H.
      Col.
    assert(HP:= l10_15 A C B D H16 H2).
    ex_and HP P.
    assert(HP:= perp_col A C P B B H10 H17 H16).
    apply perp_left_comm in HP.
    apply perp_perp_in in HP.
    assert(Per A B P).
      apply perp_in_per.
      apply perp_in_comm.
      auto.
    assert(HR:= perp_not_eq_2 A C P B H17).
    assert(HQ:=l11_16 A B P A0 B0 C0 H19 H10 HR H0 H12 H13).
    assert(LtA A B D A B P).
      apply (conga_preserves_lta A B D A0 B0 C0); auto.
        apply conga_refl; auto.
      apply conga_sym.
      auto.
    assert(LtA C B D A B P).
      apply (conga_preserves_lta C B D A0 B0 C0); auto.
        apply conga_refl; auto.
      apply conga_sym.
      auto.
    clear HQ H15 HH H3 H0 H1.
    unfold LtA in *.
    spliter.
    assert((LeA A B D A B P <-> LeA C B P C B D)).
      apply (l11_36 A B D A B P C C); auto.
    destruct H20.
    assert(LeA C B P C B D).
      apply H20.
      auto.
    assert(CongA A B P C B P).
      apply l11_16; auto.
      apply perp_in_per.
      assert(Perp C B P B).
        apply(perp_col _ A).
          auto.
          apply perp_left_comm.
          auto.
        apply bet_col in H.
        Col.
      apply perp_in_comm.
      apply perp_perp_in.
      apply perp_left_comm.
      auto.
    assert(LeA A B P C B D).
      apply (l11_30 C B P C B D); auto.
        apply conga_sym.
        auto.
      apply conga_refl; auto.
    assert(HH:=lea_asym C B D A B P H0 H24).
    contradiction.
Qed.

Lemma lcos_per : forall A B C lp l a, Q_CongA_Acute a -> Q_Cong l -> Q_Cong lp ->
  Lcos lp l a -> l A C -> lp A B -> a B A C -> Per A B C.
Proof.
    intros.
    induction(eq_dec_points B C).
      subst C.
      apply l8_5.
    unfold Lcos in H2.
    spliter.
    ex_and H9 A0.
    ex_and H10 B0.
    ex_and H9 C0.
    assert(CongA B0 A0 C0 B A C).
      apply (anga_conga a); auto.
    assert(Cong A0 C0 A C).
      apply (lg_cong l); auto.
    assert(Cong A0 B0 A B).
      apply (lg_cong lp); auto.
    assert(HH:=l11_49 B0 A0 C0 B A C H13 H15 H14).
    spliter.
    assert(B0 <> C0).
      intro.
      subst C0.
      apply H6.
      apply (cong_identity _ _ B0).
      Cong.
    apply H17 in H18.
    spliter.
    eapply (l11_17 A0 B0 C0).
      apply l8_2.
      auto.
    auto.
Qed.

Lemma is_null_anga_dec : forall a, Q_CongA_Acute a -> Q_CongA_Null_Acute a \/ ~ Q_CongA_Null_Acute a.
Proof.
    intros a H.
    assert (H' := H).
    unfold Q_CongA_Acute in H.
    destruct H as [A [B [C [Hacute HConga]]]].
    elim (out_dec B A C); intro Hout.
      left.
      unfold Q_CongA_Null_Acute.
      split; auto.
      intros.
      apply (l11_21_a A B C); auto.
      apply HConga.
      assumption.
    right.
    unfold Q_CongA_Null_Acute.
    intro H.
    destruct H as [Hclear H]; clear Hclear.
    apply Hout.
    apply H.
    apply HConga.
    apply acute_distincts in Hacute.
    spliter.
    apply conga_refl; auto.
Qed.

Lemma lcos_lg : forall a lp l A B C, Lcos lp l a -> Perp A B B C -> a B A C -> l A C -> lp A B.
Proof.
    intros.
    assert(HH:=H).
    unfold Lcos in HH.
    spliter.
    ex_and H6 A'.
    ex_and H7 B'.
    ex_and H6 C'.
    assert(Cong A C A' C').
      apply (lg_cong l); auto.
    assert(CongA B A C B' A' C').
      apply (anga_conga a); auto.
    induction(is_null_anga_dec a).
      assert(HP := null_lcos_eql lp l a H H12).
      unfold Q_CongA_Null_Acute in H12.
      spliter.
      assert(HH:= (H13 B A C H1)).
      apply perp_comm in H0.
      apply perp_not_col in H0.
      apply False_ind.
      apply H0.
      apply out_col in HH.
      Col.
      apply conga_distinct in H11.
      spliter.
      assert(CongA A B C A' B' C').
        apply l11_16; auto.
          apply perp_in_per.
          apply perp_in_comm.
          apply perp_perp_in.
          apply perp_comm.
          auto.
          apply perp_not_eq_2 in H0.
          auto.
          apply l8_2.
          auto.
        intro.
        subst C'.
        apply H12.
        unfold Q_CongA_Null_Acute.
        split; auto.
        intros.
        assert(CongA A0 B0 C0 B' A' B').
          apply (anga_conga a); auto.
        apply (l11_21_a B' A' B') .
          apply out_trivial; auto.
        apply conga_sym.
        auto.
      assert(Cong C B C' B' /\ Cong A B A' B' /\ CongA B C A B' C' A').
        apply(l11_50_2 C A B C' A' B').
          apply perp_comm in H0.
          apply perp_not_col in H0.
          intro.
          apply H0.
          Col.
          auto.
          apply conga_comm.
          auto.
        Cong.
      spliter.
      apply (lg_cong_lg lp A' B');auto.
      Cong.
    assumption.
Qed.

Lemma l13_7 : forall a b l la lb lab lba, Lcos la l a -> Lcos lb l b ->
  Lcos lab la b -> Lcos lba lb a -> EqL lab lba.
Proof.
    intros.
    apply lcos_lg_anga in H.
    apply lcos_lg_anga in H0.
    apply lcos_lg_anga in H1.
    apply lcos_lg_anga in H2.
    spliter.
    clean_duplicated_hyps.
    induction (is_null_anga_dec a).
      assert(HH:=null_lcos_eql lba lb  a H2 H3).
      assert(HP:=null_lcos_eql la l  a H H3).
      assert(Lcos lab l b) by (rewrite HP;assumption).
      assert(HQ:= l13_6 b lb lab l H0 H5).
      rewrite <- HQ;assumption.
      induction (is_null_anga_dec b).
        assert(HH:=null_lcos_eql lab la  b H1 H5).
        assert(HP:=null_lcos_eql lb l  b H0 H5).
        assert(Lcos lba l a) by (rewrite HP;auto).
        assert(HQ:= l13_6 a la lba l H H6).
        rewrite HH in HQ;assumption.
        assert(HH:=lcos_const la l a H).
        ex_and HH C.
        ex_and H6 A.
        ex_and H8 B.
        assert(HH:= anga_distincts a C A B H14 H9).
        spliter.
        assert(~Col A B C).
          intro.
          apply H3.
          assert(Col C A B).
            Col.
          assert(HH:= anga_col_null a C A B H14 H9 H18).
          spliter.
          auto.
        assert(HH:=l10_2_existence B A C).
        ex_and HH P.
        assert( ~ Col B A P).
          eapply (osym_not_col _ _ C).
            apply l10_4.
            auto.
          intro.
          apply H17.
          Col.
        assert(l B A).
          apply lg_sym; auto.
        assert(HH:= lcos_const_o lb l b B A P H19 H5 H12 H10 H11 H20 H0).
        ex_and HH D.
        assert(TS B A P C).
          apply l10_14.
            intro.
            subst P.
            assert(Col C B A).
              apply(l10_8 B A C); auto.
            apply H19.
            Col.
            auto.
          auto.
        assert(TS B A D C).
          eapply (l9_8_2 _ _ P).
            auto.
          apply one_side_symmetry.
          auto.
        assert(Per A C B).
          apply (lcos_per _ _ _ la l a); auto.
          apply lg_sym; auto.
        assert(Per A D B).
          apply (lcos_per _ _ _ lb l b); auto.
          apply anga_sym; auto.
        assert(~ Col C D A).
          intro.
          assert(Per B C D).
            apply(per_col B C A D); auto.
              apply l8_2.
              auto.
            Col.
          assert(Per B D C).
            apply(per_col B D A C); auto.
              unfold OS in H21.
              ex_and H21 T.
              unfold TS in H21.
              spliter.
              intro.
              subst D.
              apply H21.
              Col.
              apply l8_2.
              auto.
            Col.
          assert(C = D).
            apply (l8_7 B); auto.
          subst D.
          unfold TS in H25.
          spliter.
          ex_and H32 T.
          assert(C=T).
            apply between_identity.
            auto.
          subst T.
          contradiction.
        assert(HH:= l8_18_existence C D A H28).
        ex_and HH E.
        assert(CongA B A C D A E /\ CongA B A D C A E /\ Bet C E D).
          apply(l13_2 A B C D E).
            apply invert_two_sides.
            apply l9_2.
            auto.
            apply l8_2.
            auto.
            apply l8_2.
            auto.
            auto.
          apply perp_sym.
          auto.
        spliter.
        assert(a D A E).
          eapply (anga_conga_anga a B A C); auto.
          apply anga_sym; auto.
        assert(b C A E).
          eapply (anga_conga_anga b B A D); auto.
        assert(Perp C E A E).
          eapply (perp_col _ D) .
            intro.
            subst E.
            apply H5.
            unfold Q_CongA_Null_Acute.
            split; auto.
            intros.
            assert(CongA A0 B0 C0 C A C).
              apply (anga_conga b); auto.
            apply (l11_21_a C A C A0 B0 C0 ).
              apply out_trivial; auto.
            apply conga_sym.
            auto.
            auto.
          auto.
        assert(lab A E).
          apply (lcos_lg b lab la A E C H1).
            apply perp_sym in H36.
            apply perp_right_comm in H36.
            auto.
            apply anga_sym; auto.
          apply lg_sym; auto.
        assert(Perp D E A E).
          eapply (perp_col _ C) .
            intro.
            subst E.
            apply H3.
            unfold Q_CongA_Null_Acute.
            split; auto.
            intros.
            assert(CongA A0 B0 C0 D A D).
              apply (anga_conga a); auto.
            apply (l11_21_a D A D A0 B0 C0 ).
              apply out_trivial; auto.
              apply perp_not_eq_2 in H36.
              auto.
            apply conga_sym.
            auto.
            Perp.
          Col.
        assert(lba A E).
          apply (lcos_lg a lba lb A E D).
            auto.
            Perp.
            auto.
            apply anga_sym; auto.
          auto.
        apply ex_eql.
        exists A.
        exists E.
        split.
          unfold Len.
          split; auto.
        unfold Len.
        split; auto.
      assumption.
    assumption.
Qed.

Lemma out_acute : forall A B C, Out B A C -> Acute A B C.
Proof.
    intros.
    assert( A <> B /\ C <> B).
      unfold Out in H.
      tauto.
    spliter.
    assert(HH:= not_col_exists A B H0).
    ex_and HH Q.
    assert(exists P : Tpoint, Perp A B P B /\ OS A B Q P).
      apply(l10_15 A B B Q).
        Col.
      auto.
    ex_and H3 P.
    assert(Per P B A).
      apply perp_in_per.
      apply perp_left_comm in H3.
      apply perp_in_comm.
      apply perp_perp_in.
      Perp.
    unfold Acute.
    exists A.
    exists B.
    exists P.
    split.
      apply l8_2.
      auto.
    unfold LtA.
    split.
      unfold LeA.
      exists C.
      split.
        apply col_in_angle; auto.
        apply perp_not_eq_2 in H3.
        auto.
      apply conga_refl; auto.
    intro.
    apply l11_21_a in H6.
      apply perp_left_comm in H3.
      apply perp_not_col in H3.
      apply out_col in H6.
      contradiction.
    assumption.
Qed.

Lemma perp_acute : forall A B C P,  Col A C P -> Perp_at P B P A C -> Acute A B P.
Proof.
    intros.
    assert(HH0:=H0).
    assert(HH:= l11_43 P A B).
    induction(col_dec P A B).
      assert(Perp B A A C).
        eapply (perp_col _ P).
          intro.
          subst A.
          assert(Perp_at B B P C B).
            apply perp_perp_in.
            apply perp_in_perp_bis in H0.
            induction H0.
              apply perp_not_eq_1 in H0.
              tauto.
            Perp.
          assert(P=B).
            eapply(l8_14_3 B P B C); Perp.
          subst P.
          apply perp_in_perp_bis in H0.
          induction H0.
            apply perp_not_eq_1 in H0.
            tauto.
          apply perp_not_eq_1 in H0.
          tauto.
          apply perp_in_perp_bis in H0.
          induction H0.
            apply perp_not_eq_1 in H0.
            tauto.
          auto.
        Col.
      apply perp_comm in H2.
      apply perp_perp_in in H2.
      apply perp_in_comm in H2.
      apply perp_in_sym in H2.
      eapply (perp_in_col_perp_in _ _ _ _ P) in H2.
        assert( A = P).
          eapply(l8_14_3 A C B P); Perp.
        subst P.
        apply out_acute.
        apply perp_in_perp_bis in H2.
        induction H2.
          apply out_trivial.
          apply perp_not_eq_2 in H2.
          auto.
        apply perp_not_eq_1 in H2.
        tauto.
        apply perp_in_perp_bis in H0.
        induction H0; apply perp_not_eq_1 in H0; tauto.
      Col.
    apply acute_sym.
    assert_diffs.
    apply l11_43; auto.
    left.
    assert(A <> P).
      intro.
      subst P.
      apply H1.
      Col.
    eapply (perp_in_col_perp_in _ _ _ _ P) in H0; auto.
    apply perp_in_per.
    Perp.
Qed.

Lemma null_lcos : forall l a,Q_Cong l -> ~ Q_Cong_Null l -> Q_CongA_Null_Acute a -> Lcos l l a.
Proof.
    intros.
    unfold Q_CongA_Null_Acute in H1.
    spliter.
    assert(HH:=ex_points_anga a H1).
    ex_and HH A.
    ex_and H3 B.
    ex_and H4 C.
    assert(HH:=H2 A B C H3).
    unfold Lcos.
    repeat split; auto.
    assert(B <> A).
      unfold Out in HH.
      spliter.
      auto.
    lg_instance l A' B'.
    assert(HP:=ex_point_lg_out l B A H4 H H0).
    ex_and HP P.
    exists B.
    exists P.
    exists P.
    repeat split; auto.
      apply l8_2.
      apply l8_5.
    apply (anga_out_anga _ A _ C); auto.
      apply l6_6.
      auto.
    apply (l6_7 _ _ A); apply l6_6.
      auto.
    auto.
Qed.

Lemma lcos_exists : forall l a, Q_CongA_Acute a -> Q_Cong l -> ~ Q_Cong_Null l -> exists lp, Lcos lp l a.
Proof.
    intros.
    lg_instance l A B.
    induction(is_null_anga_dec a).
      exists l.
      apply null_lcos; auto.
      anga_instance1 a A B C.
        assert(~ Col B C A).
          intro.
          assert(Out B A C /\ Q_CongA_Null_Acute a).
            apply(anga_col_null a A B C H H4).
            Col.
          apply H3.
          tauto.
        assert(HH:= l8_18_existence B C A H5).
        ex_and HH P.
        assert(HH:=lg_exists B P).
        ex_and HH lp.
        exists lp.
        assert(Acute A B C).
          unfold Q_CongA_Acute in H.
          ex_and H A'.
          ex_and H10 B'.
          ex_and H C'.
          assert(HH:=H10 A B C).
          destruct HH.
          assert(HP:= H12 H4).
          apply (acute_lea_acute _ _ _ A' B' C'); auto.
          unfold LeA.
          exists C'.
          split.
            apply conga_distinct in HP.
            spliter.
            apply inangle3123; auto.
          apply conga_sym.
          auto.
        unfold Lcos.
        repeat split; auto.
        exists B.
        exists P.
        exists A.
        repeat split; auto.
          apply perp_in_per.
          apply perp_in_comm.
          apply perp_perp_in.
          apply perp_sym.
          apply (perp_col _ C).
            intro.
            subst P.
            assert(Per A B C).
              apply perp_in_per.
              apply perp_in_comm.
              apply perp_perp_in.
              Perp.
            apply acute_not_per in H10.
            contradiction.
            Perp.
          Col.
          apply (lg_sym l); auto.
        assert(HH:=H10).
        unfold Acute in HH.
        apply(anga_sym a); auto.
        apply(anga_out_anga a A B C A P); auto.
          apply out_trivial.
          intro.
          subst B.
          apply H5.
          Col.
        eapply (perp_acute_out _ _ A).
          apply acute_sym.
          auto.
          Perp.
        Col.
      intro.
      apply H1.
      unfold Q_Cong_Null.
      split; auto.
      subst B.
      exists A.
      auto.
    assumption.
Qed.

Lemma lcos_uniqueness : forall l a l1 l2, Lcos l1 l a-> Lcos l2 l a -> EqL l1 l2.
Proof.
intros.
unfold Lcos in *.
spliter.
ex_and H6 A1.
ex_and H7 B1.
ex_and H6 C1.
ex_and H3 A2.
ex_and H10 B2.
ex_and H3 C2.

assert(Cong A1 C1 A2 C2).
apply (lg_cong l); auto.

assert(CongA B1 A1 C1 B2 A2 C2).
apply (anga_conga a); auto.

induction(eq_dec_points C1 B1).
subst C1.

assert(EqL l l1).
apply ex_eqL; auto.
exists A1.
exists B1.
split; auto.

assert(Out A2 B2 C2).
apply (l11_21_a B1 A1 B1).
apply out_trivial.
intro.
subst B1.
apply conga_distinct in H14.
tauto.
auto.

assert(C2 = B2 \/ A2 = B2).
apply(l8_9 C2 B2 A2).
auto.
apply out_col in H16.
Col.
induction H17.
subst C2.

assert(EqL l l2).
apply ex_eqL; auto.
exists A2.
exists B2.
split; auto.
transitivity l; auto.
symmetry; auto.

subst B2.
apply conga_distinct in H14.
tauto.

apply conga_distinct in H14.
spliter.
assert(CongA C1 B1 A1 C2 B2 A2).
apply l11_16; auto.
intro.
subst C2.

assert(Out A1 B1 C1).
apply (l11_21_a B2 A2 B2).
apply out_trivial; auto.
apply conga_sym.
auto.
assert(C1 = B1 \/ A1 = B1).
apply(l8_9 C1 B1 A1 ); auto.
apply out_col in H20.
Col.
induction H21.
subst C1.
tauto.
subst B1.
tauto.

assert( Cong C1 B1 C2 B2 /\ Cong A1 B1 A2 B2 /\ CongA B1 C1 A1 B2 C2 A2).
apply(l11_50_2 C1 A1 B1 C2 A2 B2).
intro.
assert(C1 = B1 \/ A1 = B1).
apply(l8_9 C1 B1 A1 ); auto.
Col.
induction H22.
contradiction.
subst B1.
tauto.
apply conga_comm.
auto.
apply conga_comm.
auto.
Cong.
spliter.

apply ex_eqL; auto.
exists A1.
exists B1.
split; auto.
apply (lg_cong_lg l2 A2 B2); auto.
Cong.
Qed.

Lemma lcos_eqa_lcos : forall lp l a b, Lcos lp l a -> EqA a b -> Lcos lp l b.
Proof.
    intros.
    assert(HH:=lcos_lg_anga l lp a H).
    spliter.
    clear H1.
    assert(HH:= H0).
    unfold EqA in HH.
    assert (Q_CongA a) by (apply anga_is_ang;auto).
    assert (Q_CongA b) by (apply eqA_preserves_ang with a;auto).
    assert (Q_CongA_Acute b).
      apply (eqA_preserves_anga a b); auto.
    unfold Lcos in *.
    spliter.
    repeat split; auto.
    ex_and H9 A.
    ex_and H10 B.
    ex_and H9 C.
    exists A.
    exists B.
    exists C.
    repeat split; auto.
    apply HH;auto.
Qed.

Lemma lcos_eq_refl : forall la a, Q_Cong la -> ~ Q_Cong_Null la -> Q_CongA_Acute a -> Eq_Lcos la a la a.
Proof.
    intros.
    unfold Eq_Lcos.
    assert(HH:=lcos_exists la a H1 H H0).
    ex_and HH lp.
    exists lp.
    split; auto.
Qed.

Lemma lcos_eq_sym : forall la a lb b, Eq_Lcos la a lb b -> Eq_Lcos lb b la a.
Proof.
    intros.
    unfold Eq_Lcos in *.
    ex_and H lp.
    exists lp.
    split; auto.
Qed.

Lemma lcos_eq_trans : forall la a lb b lc c, Eq_Lcos la a lb b -> Eq_Lcos lb b lc c -> Eq_Lcos la a lc c.
Proof.
    intros.
    unfold Eq_Lcos in *.
    ex_and H lab.
    ex_and H0 lbc.
    assert(HH:= l13_6 b lab lbc lb H1 H0).
    assert(Lcos lbc la a).
      rewrite <- HH.
      apply lcos_lg_anga in H.
      tauto.
    exists lbc.
    split; auto.
Qed.

Lemma lcos2_comm : forall lp l a b, Lcos2 lp l a b -> Lcos2 lp l b a.
Proof.
    intros.
    unfold Lcos2 in *.
    ex_and H la.
    apply lcos_lg_anga in H.
    apply lcos_lg_anga in H0.
    spliter.
    assert(exists lb, Lcos lb l b).
      apply(lcos_exists l b); auto.
      assert(HH:= lcos_lg_not_null la l a H).
      tauto.
    ex_and H7 lb.
    apply lcos_lg_anga in H8.
    spliter.
    exists lb.
    split.
      auto.
    assert(exists lp', Lcos lp' lb a).
      apply(lcos_exists lb a); auto.
      assert(HH:= lcos_lg_not_null lb l b H7).
      tauto.
    ex_and H11 lp'.
    assert(EqL lp lp').
      apply(l13_7 a b l la lb lp lp'); auto.
    apply lcos_lg_anga in H12.
    rewrite H11. tauto.
Qed.

Lemma lcos2_exists : forall l a b, Q_Cong l -> ~ Q_Cong_Null l -> Q_CongA_Acute a -> Q_CongA_Acute b ->
 exists lp, Lcos2 lp l a b.
Proof.
    intros.
    assert(HH:= lcos_exists l a H1 H H0).
    ex_and HH la.
    apply lcos_lg_anga in H3.
    spliter.
    assert(~ Q_Cong_Null la /\ ~ Q_Cong_Null l).
      apply (lcos_lg_not_null _ _ a).
      auto.
    spliter.
    clear H8.
    assert(HH:= lcos_exists la b H2 H5 H7).
    ex_and HH lab.
    exists lab.
    unfold Lcos2.
    exists la.
    split; auto.
Qed.

Lemma lcos2_exists' : forall l a b, Q_Cong l -> ~ Q_Cong_Null l -> Q_CongA_Acute a -> Q_CongA_Acute b ->
 exists la, exists lab, Lcos la l a /\ Lcos lab la b.
Proof.
    intros.
    assert(HH:=lcos_exists l a H1 H H0).
    ex_and HH la.
    exists la.
    apply lcos_lg_anga in H3.
    spliter.
    assert(HP:=lcos_not_lg_null la l a H3).
    assert(HH:=lcos_exists la b H2 H5 HP).
    ex_and HH lab.
    exists lab.
    split; auto.
Qed.

Lemma lcos2_eq_refl : forall l a b, Q_Cong l -> ~ Q_Cong_Null l -> Q_CongA_Acute a -> Q_CongA_Acute b -> Eq_Lcos2 l a b l a b.
Proof.
    intros.
    assert(HH:= lcos2_exists l a b H H0 H1 H2).
    ex_and HH lab.
    unfold Eq_Lcos2.
    exists lab.
    split; auto.
Qed.

Lemma lcos2_eq_sym : forall l1 a b l2 c d, Eq_Lcos2 l1 a b l2 c d -> Eq_Lcos2 l2 c d l1 a b.
Proof.
    intros.
    unfold Eq_Lcos2 in *.
    ex_and H lp.
    exists lp.
    auto.
Qed.

Lemma lcos2_uniqueness: forall l l1 l2 a b, Lcos2 l1 l a b -> Lcos2 l2 l a b -> EqL l1 l2.
Proof.
    intros.
    unfold Lcos2 in *.
    ex_and H la.
    ex_and H0 lb.
    assert(EqL la lb).
      apply (l13_6 a _ _ l); auto.
    apply lcos_lg_anga in H2.
    apply lcos_lg_anga in H1.
    spliter.
    assert(Lcos l2 la b).
      rewrite H3;auto.
    apply (l13_6 b _ _ la); auto.
Qed.

Lemma lcos2_eql_lcos2 : forall lla llb la lb a b, Lcos2 la lla a b -> EqL lla llb -> EqL la lb -> Lcos2 lb llb a b.
Proof.
    intros.
    unfold Lcos2 in *.
    ex_and H l.
    exists l.
    apply lcos_lg_anga in H.
    apply lcos_lg_anga in H2.
    spliter.
    split.
    rewrite <- H0;auto.
    rewrite <- H1;auto.
Qed.

Lemma lcos2_lg_anga : forall lp l a b, Lcos2 lp l a b -> Lcos2 lp l a b /\ Q_Cong lp /\ Q_Cong l /\ Q_CongA_Acute a /\ Q_CongA_Acute b.
Proof.
    intros.
    split; auto.
    unfold Lcos2 in H.
    ex_and H ll.
    apply lcos_lg_anga in H.
    apply lcos_lg_anga in H0.
    spliter.
    split; auto.
Qed.

Lemma lcos2_eq_trans : forall l1 a b l2 c d l3 e f, Eq_Lcos2 l1 a b l2 c d -> Eq_Lcos2 l2 c d l3 e f
                                   -> Eq_Lcos2 l1 a b l3 e f.
Proof.
    intros.
    unfold Eq_Lcos2 in *.
    ex_and H lp.
    ex_and H0 lq.
    exists lp.
    split; auto.
    assert(EqL lp lq).
      eapply (lcos2_uniqueness l2 _ _ c d); auto.
    apply lcos2_lg_anga in H2.
    apply lcos2_lg_anga in H1.
    spliter.
    eapply (lcos2_eql_lcos2 l3 _ lq); auto.
      reflexivity.
    symmetry; auto.
Qed.

Lemma lcos_eq_lcos2_eq : forall la lb a b c, Q_CongA_Acute c -> Eq_Lcos la a lb b -> Eq_Lcos2 la a c lb b c.
Proof.
    intros.
    assert(HH0:=H0).
    unfold Eq_Lcos in HH0.
    ex_and HH0 lp.
    apply lcos_lg_anga in H1.
    apply lcos_lg_anga in H2.
    spliter.
    clear H7.
    assert(~ Q_Cong_Null lp /\ ~ Q_Cong_Null la).
      apply (lcos_lg_not_null _ _ a).
      auto.
    spliter.
    unfold Eq_Lcos2.
    assert(HH:= lcos_exists lp c H H4 H7).
    ex_and HH lq.
    exists lq.
    split.
      unfold Lcos2.
      exists lp.
      split; auto.
    unfold Lcos2.
    exists lp.
    split; auto.
Qed.

Lemma lcos2_lg_not_null: forall lp l a b, Lcos2 lp l a b -> ~ Q_Cong_Null l /\ ~ Q_Cong_Null lp.
Proof.
    intros.
    unfold Lcos2 in H.
    ex_and H la.
    apply lcos_lg_not_null in H.
    apply lcos_lg_not_null in H0.
    spliter.
    split; auto.
Qed.

Lemma lcos3_lcos_1_2 : forall lp l a b c, Lcos3 lp l a b c <-> exists la, Lcos la l a /\ Lcos2 lp la b c.
Proof.
    intros.
    split.
      intro.
      unfold Lcos3 in H.
      ex_and H la.
      ex_and H0 lab.
      exists la.
      split; auto.
      unfold Lcos2.
      exists lab.
      split; auto.
    intro.
    ex_and H la.
    unfold Lcos2 in H0.
    ex_and H0 lab.
    unfold Lcos3.
    exists la.
    exists lab.
    apply lcos_lg_anga in H0.
    apply lcos_lg_anga in H1.
    spliter.
    split; auto.
Qed.

Lemma lcos3_lcos_2_1 : forall lp l a b c, Lcos3 lp l a b c <-> exists lab, Lcos2 lab l a b /\ Lcos lp lab c.
Proof.
    intros.
    split.
      intro.
      unfold Lcos3 in H.
      ex_and H la.
      ex_and H0 lab.
      exists lab.
      split.
        unfold Lcos2.
        exists la.
        split; assumption.
      assumption.
    intro.
    ex_and H lab.
    unfold Lcos3.
    unfold Lcos2 in H.
    ex_and H la.
    exists la.
    exists lab.
    split; auto.
Qed.

Lemma lcos3_permut3 : forall lp l a b c, Lcos3 lp l a b c -> Lcos3 lp l b a c.
Proof.
    intros.
    assert(HH:= lcos3_lcos_2_1 lp l a b c).
    destruct HH.
    assert(exists lab : Tpoint -> Tpoint -> Prop, Lcos2 lab l a b /\ Lcos lp lab c).
      apply lcos3_lcos_2_1; auto.
    ex_and H2 lab.
    apply lcos2_comm in H2.
    apply lcos3_lcos_2_1.
    exists lab.
    split; auto.
Qed.

Lemma lcos3_permut1 : forall lp l a b c, Lcos3 lp l a b c -> Lcos3 lp l a c b.
Proof.
    intros.
    assert(HH:= lcos3_lcos_1_2 lp l a b c).
    destruct HH.
    assert(exists la : Tpoint -> Tpoint -> Prop, Lcos la l a /\ Lcos2 lp la b c).
      apply lcos3_lcos_1_2; auto.
    ex_and H2 la.
    apply lcos2_comm in H3.
    apply lcos3_lcos_1_2.
    exists la.
    split; auto.
Qed.

Lemma lcos3_permut2 : forall lp l a b c, Lcos3 lp l a b c -> Lcos3 lp l c b a.
Proof.
    intros.
    apply lcos3_permut3.
    apply lcos3_permut1.
    apply lcos3_permut3.
    auto.
Qed.

Lemma lcos3_exists : forall l a b c, Q_Cong l -> ~ Q_Cong_Null l -> Q_CongA_Acute a -> Q_CongA_Acute b -> Q_CongA_Acute c ->
 exists lp, Lcos3 lp l a b c.
Proof.
    intros.
    assert(HH:= lcos_exists l a H1 H H0).
    ex_and HH la.
    apply lcos_lg_anga in H4.
    spliter.
    assert(~ Q_Cong_Null la /\ ~ Q_Cong_Null l).
      apply (lcos_lg_not_null _ _ a).
      auto.
    spliter.
    clear H9.
    clear H7.
    assert(HH:= lcos_exists la b H2 H6 H8).
    ex_and HH lab.
    apply lcos_lg_anga in H7.
    spliter.
    assert(~ Q_Cong_Null lab /\ ~ Q_Cong_Null la).
      apply (lcos_lg_not_null _ _ b).
      auto.
    spliter.
    assert(HH:= lcos_exists lab c H3 H10 H12).
    ex_and HH lp.
    exists lp.
    unfold Lcos3.
    exists la.
    exists lab.
    split;auto.
Qed.

(*----------------------------------------*)

Lemma lcos3_eq_refl : forall l a b c, Q_Cong l -> ~ Q_Cong_Null l -> Q_CongA_Acute a -> Q_CongA_Acute b -> Q_CongA_Acute c -> Eq_Lcos3 l a b c l a b c.
Proof.
    intros.
    assert(HH:= lcos3_exists l a b c H H0 H1 H2 H3).
    ex_and HH lp.
    unfold Eq_Lcos3.
    exists lp.
    split; auto.
Qed.

Lemma lcos3_eq_sym : forall l1 a b c l2 d e f, Eq_Lcos3 l1 a b c l2 d e f -> Eq_Lcos3 l2 d e f l1 a b c.
Proof.
    intros.
    unfold Eq_Lcos3 in *.
    ex_and H lp.
    exists lp.
    auto.
Qed.

Lemma lcos3_uniqueness: forall l l1 l2 a b c, Lcos3 l1 l a b c -> Lcos3 l2 l a b c -> EqL l1 l2.
Proof.
    intros.
    unfold Lcos3 in *.
    ex_and H la.
    ex_and H1 lab.
    ex_and H0 la'.
    ex_and H3 lab'.
    assert(EqL la la').
      apply (l13_6 a _ _ l); auto.
    apply lcos_lg_anga in H2.
    apply lcos_lg_anga in H3.
    apply lcos_lg_anga in H.
    apply lcos_lg_anga in H4.
    spliter.
    assert(Lcos lab' la b).
      rewrite H5;auto.
    assert(EqL lab lab') by
      (apply (l13_6 b _ _ la); auto).
    assert(Lcos l2 lab c).
      rewrite H19. auto.
    apply (l13_6 c _ _ lab); auto.
Qed.

Lemma lcos3_eql_lcos3 : forall lla llb la lb a b c, Lcos3 la lla a b c -> EqL lla llb -> EqL la lb -> Lcos3 lb llb a b c.
Proof.
    intros.
    unfold Lcos3 in *.
    ex_and H lpa.
    exists lpa.
    ex_and H2 lpab.
    exists lpab.
    apply lcos_lg_anga in H.
    apply lcos_lg_anga in H2.
    apply lcos_lg_anga in H3.
    spliter.
    split.
    rewrite <- H0;auto.
    split.
      auto.
    rewrite <- H1;auto.
Qed.

Lemma lcos3_lg_anga : forall lp l a b c, Lcos3 lp l a b c -> Lcos3 lp l a b c /\ Q_Cong lp /\ Q_Cong l /\ Q_CongA_Acute a /\ Q_CongA_Acute b /\ Q_CongA_Acute c.
Proof.
    intros.
    split; auto.
    unfold Lcos3 in H.
    ex_and H la.
    ex_and H0 lab.
    apply lcos_lg_anga in H.
    apply lcos_lg_anga in H0.
    apply lcos_lg_anga in H1.
    spliter.
    split; auto.
Qed.

Lemma lcos3_lg_not_null: forall lp l a b c, Lcos3 lp l a b c -> ~ Q_Cong_Null l /\ ~ Q_Cong_Null lp.
Proof.
    intros.
    unfold Lcos3 in H.
    ex_and H la.
    ex_and H0 lab.
    apply lcos_lg_not_null in H.
    apply lcos_lg_not_null in H1.
    spliter.
    split; auto.
Qed.

Lemma lcos3_eq_trans : forall l1 a b c l2 d e f l3 g h i,
 Eq_Lcos3 l1 a b c l2 d e f -> Eq_Lcos3 l2 d e f l3 g h i -> Eq_Lcos3 l1 a b c l3 g h i.
Proof.
    intros.
    unfold Eq_Lcos3 in *.
    ex_and H lp.
    ex_and H0 lq.
    exists lp.
    split; auto.
    assert(EqL lp lq).
      eapply (lcos3_uniqueness l2 _ _ d e f); auto.
    apply lcos3_lg_anga in H2.
    apply lcos3_lg_anga in H1.
    spliter.
    eapply (lcos3_eql_lcos3 l3 _ lq); auto.
      reflexivity.
    symmetry; auto.
Qed.

Lemma lcos_eq_lcos3_eq : forall la lb a b c d, Q_CongA_Acute c -> Q_CongA_Acute d -> Eq_Lcos la a lb b -> Eq_Lcos3 la a c d lb b c d.
Proof.
    intros.
    assert(HH1:=H1).
    unfold Eq_Lcos in HH1.
    ex_and HH1 lp.
    apply lcos_lg_anga in H2.
    apply lcos_lg_anga in H3.
    spliter.
    assert(~ Q_Cong_Null lp /\ ~ Q_Cong_Null la).
      apply (lcos_lg_not_null _ _ a).
      auto.
    spliter.
    assert(HH:= lcos_exists lp c H H5 H10).
    ex_and HH lq.
    apply lcos_lg_anga in H12.
    spliter.
    assert(~ Q_Cong_Null lq /\ ~ Q_Cong_Null lp).
      apply (lcos_lg_not_null _ _ c); auto.
    spliter.
    assert(HH:= lcos_exists lq d H0 H14 H16).
    ex_and HH lm.
    unfold Eq_Lcos3.
    exists lm.
    split; unfold Lcos3.
      exists lp.
      exists lq.
      split; auto.
    exists lp.
    exists lq.
    split; auto.
Qed.

Lemma lcos2_eq_lcos3_eq : forall la lb a b c d e, Q_CongA_Acute e -> Eq_Lcos2 la a b lb c d -> Eq_Lcos3 la a b e lb c d e.
Proof.
    intros.
    assert(HH0:=H0).
    unfold Eq_Lcos2 in HH0.
    ex_and HH0 lp.
    apply lcos2_lg_anga in H1.
    apply lcos2_lg_anga in H2.
    spliter.
    assert(~ Q_Cong_Null la /\ ~ Q_Cong_Null lp).
      eapply (lcos2_lg_not_null _ _ a b).
      auto.
    spliter.
    assert(HH:= lcos_exists lp e H H3 H12).
    ex_and HH lq.
    apply lcos_lg_anga in H13.
    spliter.
    assert(~ Q_Cong_Null lq /\ ~ Q_Cong_Null lp).
      apply (lcos_lg_not_null _ _ e); auto.
    spliter.
    unfold Eq_Lcos3.
    exists lq.
    split; apply lcos3_lcos_2_1; exists lp; split; auto.
Qed.

End Cosinus2.