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

- Frédéric Blanqui, 2014-02-18

Some structures on arctic below zero numbers. *)

Set Implicit Arguments.

Require Import Arith OrdSemiRing2 Omega LogicUtil RelUtil Morphisms
SemiRing EqUtil Max.

Instance ArcticBZ_as_Setoid : Setoid := LeibnizSetoid ArcticBZDom.

Instance ArcticBZ_as_DS : DecidableSetoid.

Proof.
  apply Build_DecidableSetoid with (ds_setoid := ArcticBZ_as_Setoid).
  simpl. intros.
  apply dec_beq with (beq := beq_ArcticBZDom).
  apply beq_ArcticBZDom_ok.
Defined.

Local Open Scope Z_scope.

Definition gt m n :=
    match m, n with
    | MinusInfBZ, _ => False
    | Fin _, MinusInfBZ => True
    | Fin m, Fin n => m > n
    end.

Definition ge m n := gt m n \/ m = n.

(***********************************************************************)
(* Define [is_above_zero] used in AArcticBZInt.v *)

Require Import ZUtil.

Definition is_above_zero v :=
  match v with
    | MinusInfBZ => false
    | Fin z => is_not_neg z
  end.

Lemma is_above_zero_ok :
  forall v, is_above_zero v = true <-> ge v (Fin 0).
Proof.
  intro. destruct v; simpl; intuition.
  destruct z. right. refl. left. simpl.
  auto with zarith. discr.
  rewrite is_not_neg_ok. destruct H. simpl in H.
  auto with zarith.
  inversion H. auto with zarith.
  destruct H. simpl in H. contr. discr.
Qed.

(***********************************************************************)
(** Arctic below zero ordered setoid *)

Instance ArcticBZ_as_OS : OrderedSetoid.

Proof.
  apply Build_OrderedSetoid with
  (os_setoid := ArcticBZ_as_Setoid)
  (os_gt := gt).
  simpl. intros x x' xx' y y' yy' xy. rewrite <- xx'.
  rewrite <- yy'. apply xy.
Defined.

(***********************************************************************)
(** Arctic below zero semi-ring *)

Definition A0 := MinusInfBZ.
Definition A1 := Fin 0.

(* max is a <+> operation in the semi-ring *)
Definition Aplus m n :=
  match m, n with
    | MinusInfBZ, n => n
    | m, MinusInfBZ => m
    | Fin m, Fin n => Fin (Zmax m n)
  end.

(* plus is a <*> operation in the semi-ring *)
Definition Amult m n :=
  match m, n with
    | MinusInfBZ, _ => MinusInfBZ
    | _, MinusInfBZ => MinusInfBZ
    | Fin m, Fin n => Fin (m + n)
  end.

Lemma A_plus_comm : forall m n, Aplus m n = Aplus n m.

Proof.
  intros. unfold Aplus. destruct m; destruct n; trivial.
  rewrite Zmax_comm. refl.
Qed.

Lemma A_plus_assoc : forall m n p,
  Aplus m (Aplus n p) = Aplus (Aplus m n) p.

Proof.
  intros. unfold Aplus.
  destruct m; destruct n; destruct p; trivial.
  rewrite Zmax_assoc. refl.
Qed.

Lemma A_mult_comm : forall m n, Amult m n = Amult n m.

Proof.
  intros. unfold Amult. destruct m; destruct n; trivial.
  rewrite Zplus_comm. refl.
Qed.

Lemma A_mult_assoc : forall m n p,
  Amult m (Amult n p) = Amult (Amult m n) p.

Proof.
  intros. unfold Amult.
  destruct m; destruct n; destruct p; trivial.
  rewrite Zplus_assoc. refl.
Qed.

Lemma A_mult_plus_distr : forall m n p,
  Amult (Aplus m n) p = Aplus (Amult m p) (Amult n p).

Proof.
  intros. unfold Amult, Aplus.
  destruct m; destruct n; destruct p; trivial.
  rewrite Zplus_max_distr_r.
  destruct (Zmax_irreducible_inf z z0); rewrite e; refl.
Qed.

Instance ArcticBZ_as_SR : SemiRing.

Proof.
apply Build_SemiRing with
(sr_ds  := ArcticBZ_as_DS)
(sr_0   := MinusInfBZ)
(sr_1   := Fin 0)
(sr_add := Aplus)
(sr_mul := Amult).
(* Aplus eq as proper. *)
intros x y z xx yy H. rewrite H. rewrite z. refl.
(* Amult eq as proper. *)
intros x y z xx yy H. rewrite H. rewrite z. refl.
(* semi-ring-theory. *)
constructor; intros.
compute; trivial.
apply A_plus_comm.
apply A_plus_assoc.
destruct n; compute; trivial.
compute; trivial.
apply A_mult_comm.
apply A_mult_assoc.
apply A_mult_plus_distr.
Defined.

(***********************************************************************)
(** Arctic below zero ordered semi-ring. *)

Notation "x + y"    := (Aplus x y).
Notation "x * y"    := (Amult x y).
Notation "x >_b y"  := (gt x y) (at level 70).
Notation "x >=_b y" := (ge x y) (at level 70).

Lemma gt_trans : transitive gt.

Proof.
  intros m n p mn np.
  destruct m; auto.
  destruct n.
  destruct p; auto.
  simpl in *. omega.
  simpl in *. tauto.
Qed.

Lemma ge_trans : transitive ge.

Proof.
  intros m n p mn np.
  destruct mn.
  destruct np.
  left. apply (gt_trans m n p); hyp.
  rewrite <- H0. left. trivial.
  rewrite H. trivial.
Qed.

Lemma gt_dec : rel_dec gt.

Proof.
  intros x y.
  destruct x; destruct y; simpl; auto.
  destruct (Z_lt_dec z0 z); [left | right]; omega.
Defined.

Lemma ge_dec : rel_dec ge.

Proof.
  intros x y.
  destruct (gt_dec x y).
  left. left. trivial.
  destruct (@ds_eq_dec ArcticBZ_as_DS x y).
  left. right. trivial.
  right. intro xy. destruct xy; auto.
Defined.

(* ge @ gt << gt : ge_gt_compat *)

Lemma ge_gt_compat: forall x y z, x >=_b y -> y >_b z -> x >_b z.

Proof.
  intros. destruct y. destruct x. destruct z.
  unfold gt, ge in *. destruct H.
  simpl in H. omega.
  injection H. intro. subst z0. hyp.
  auto.
  elimtype False. destruct H. auto. discr.
  elimtype False. destruct H. auto. subst x. auto.
Qed.

(* gt @ ge << gt : gt_ge_compat *)

Lemma gt_ge_compat: forall x y z, x >_b y -> y >=_b z -> x >_b z.

Proof.
  unfold ge, gt. destruct x as [x|]; destruct y as [y|];
                 try destruct z as [z|]; simpl; intuition.
  inversion H1. subst. hyp. discr.
Qed.

Lemma ge_impl_fin_ge : forall m n, (m >= n)%Z -> Fin m >=_b Fin n.

Proof.
  intros. destruct (Z_le_lt_eq_dec n m). omega.
  left. simpl. omega.
  subst n. right. refl.
Qed.

Lemma fin_ge_impl_ge : forall m n, Fin m >=_b Fin n -> (m >= n)%Z.

Proof.
  intros. destruct H.
  simpl in H. omega.
  injection H. intro. subst m. omega.
Qed.

Ltac arctic_ord :=
  match goal with
    | H: MinusInfBZ >_b Fin _ |- _ =>
      contr
    | H: MinusInfBZ >=_b Fin _ |- _ =>
      destruct H; [ contr | discr ]
    | H: Fin ?m >=_b Fin ?n |- _ =>
      assert ((m >= n)%Z);
        [ apply fin_ge_impl_ge; hyp
        | clear H; arctic_ord
        ]
    | |- Fin _ >=_b MinusInfBZ => left; simpl; trivial
    | |- Fin ?m >=_b Fin ?n => apply ge_impl_fin_ge
    | _ => try solve [contr | discr]
  end.

Lemma plus_gt_compat: Proper (gt ==> gt ==> gt) Aplus.

Proof.
intros m m' H n n' H0.
 destruct m; destruct n; destruct m'; destruct n';
      simpl; trivial; arctic_ord; simpl in *.
 apply ZUtil.Zmax_gt_compat; hyp.
 apply Zlt_gt. apply ZUtil.elim_lt_Zmax_l. omega.
 apply Zlt_gt. apply ZUtil.elim_lt_Zmax_r. omega.
Qed.

Lemma plus_ge_compat: Proper (ge ==> ge ==> ge) Aplus.
Proof.
intros m m' H n n' H0.
destruct m; destruct n; destruct m'; destruct n';
simpl; trivial; arctic_ord.
apply ZUtil.Zmax_ge_compat; hyp.
apply Zle_ge. apply ZUtil.elim_Zmax_l. omega.
apply Zle_ge. apply ZUtil.elim_Zmax_r. omega.
Qed.

Lemma mult_ge_compat: Proper (ge ==> ge ==> ge) Amult.

Proof.
intros m m' H n n' H0.
destruct m; destruct n; destruct m'; destruct n';
simpl; trivial; arctic_ord.
omega.
Qed.

Instance ArcticBZ_as_OSR : OrderedSemiRing.

Proof.
apply Build_OrderedSemiRing with
(osr_sr := ArcticBZ_as_SR)
(osr_gt := gt)
(osr_ge := ge); simpl.
fo. fo.
(* Transitive ge *)
apply ge_trans.
(* Transitive gt *)
apply gt_trans.
(* rel_dec ge *)
apply ge_dec.
(* rel_dec gt *)
apply gt_dec.
(* ge @ gt << gt *)
apply ge_gt_compat.
(* gt @ ge << gt *)
apply gt_ge_compat.
(* Aplus gt proper: plus_gt_compat *)
apply plus_gt_compat.
(* Aplus ge proper: plus_ge_compat *)
apply plus_ge_compat.
(* Mult ge proper: mult_ge_compat *)
apply mult_ge_compat.
Defined.

(** Properties of arctic below zero. *)

Lemma ge_gt_eq : forall x y, x >=_b y -> x >_b y \/ x = y.

Proof.
  destruct 1; auto.
Qed.

Lemma minusInf_ge_min : forall a, a >=_b MinusInfBZ.

Proof.
  intros. destruct a. left. simpl. trivial.
  right. refl.
Qed.

Lemma arctic_plus_ge_monotone :
  forall (a b c : s_typ),
    a >=_b c -> Aplus a b >=_b c.

Proof.
  intros. destruct c.
  destruct a. destruct b. simpl. arctic_ord.
  apply Zle_ge. apply elim_Zmax_l. omega.
  trivial.
  arctic_ord.
  apply minusInf_ge_min.
Qed.

Lemma A_plus_0_r : forall n, Aplus n MinusInfBZ = n.

Proof.
  intros. unfold Aplus. destruct n; auto.
Qed.

Lemma A_plus_0_l : forall n, Aplus MinusInfBZ n = n.

Proof.
  intros. rewrite A_plus_comm. apply A_plus_0_r.
Qed.


(* The First Logical Relations Proof: Measure Semantics vs. Sampler Semantics *)

Require Import Coq.Lists.List.
Require Import Coq.Logic.FunctionalExtensionality.

Require Import LiftedTypes.
Require Import Weights.
Require Import MyReals.                   (* including times: Weight -> real -> real *)
Require Import Measures.
Require Import Types.                     (* including variables and environments *)

Require Import Syntax.

Require Import MeasureSemantics.
Require Import SamplingSemantics.

(* false_invert: tactic from SF *)
(* false_invert proves any goal provided there is at least one *)
(* hypothesis H in the context that can be proved absurd by calling *)
(* inversion H. *)

Ltac false_invert :=
  intros;
  match goal with
    [ H:_ |- _ ] => solve [ inversion H ]
  end.

(* **************************************************************** *)

Definition EqReal : (den_Mtype Real_type) ->
                    (den_Mtype Real_type) -> Prop :=
  fun v1 v2 => (v1 = v2).

Hint Unfold EqReal.

Function EqMtype (m : Mtype) : (den_typeM (Stype m))
                               -> (den_typeS (Stype m)) -> Prop
  :=
    match m with
    | Empty_type => fun v1 v2 => True
    | Real_type => EqReal
    |Prod_type m1 m2 => fun v1 v2 => (EqMtype m1 (fst v1) (fst v2))
                                     /\ (EqMtype m2 (snd v1) (snd v2))
    end.

Hint Unfold EqMtype.

Function coerceMS {m} (v: den_typeM (Stype m)) : (den_typeS (Stype m))
  := v.

Hint Unfold coerceMS.

Theorem EqMtype_coerce : forall (m : Mtype) (v: den_typeM (Stype m)),
    EqMtype m (@coerceMS m v) v.
Proof.
  induction m; auto.
  constructor.
  - apply IHm1.
  - apply IHm2.
Qed.

Theorem EqMtype_injective :
  forall (m : Mtype)  (v v': den_typeM (Stype m)),
    EqMtype m (@coerceMS m v) v' -> v = v'.
Proof.
  induction m; auto.
  destruct v, v'.
  unfold EqMtype.
  auto.
  intros. destruct v,v'.
  simpl in H. inversion H; clear H.
  apply IHm1 in H0.
  apply IHm2 in H1.
  f_equal; auto.
Qed.

Function lift_Rel {A B : Type} (R : (A -> B -> Prop)) :
  ((lifted A) -> (lifted B) -> Prop) :=
  fun d d' =>
    match (d, d') with
      | (bottom, bottom) => True
      | (lift u, lift u') => R u u'
      | _ => False
    end.
Hint Unfold lift_Rel.

(* Finally, here's the relation Rel itself, defined as a Fixpoint over
   Otypes.  *)

Fixpoint Rel (t : Otype) : (den_typeM t) -> (den_typeS t) -> Prop :=
  match t with
  | Stype m => EqMtype m
  | Funtype t u => (fun f1 f2 =>
                      forall a1 a2,
                        (Rel t a1 a2)
                        -> (lift_Rel (Rel u) (f1 a1) (f2 a2)))
  | Meastype t => (fun mu s =>
                     forall k,
                       mu k =
                       mu_L (fun u => (strict20 (s u)
                                                (fun a w => (times w (k a))))))
  end.
Hint Unfold Rel.

Definition den_envM := @den_env den_typeM.
Definition den_envS := @den_env den_typeS.

Fixpoint Rel_Env G : (den_envM G) -> (den_envS G)
                     -> Prop :=
  match G with
    | nil => fun r1 r2 => True
    | (o :: G') => fun r1 r2 =>
                     Rel o (fst r1) (fst r2)
                     /\ Rel_Env G' (snd r1) (snd r2)
  end.
Hint Unfold Rel_Env.

Lemma Fund_Env : forall G (o : Otype)
                        (var : Var G o)
                        (r1 : den_envM G)
                        (r2 : den_envS G),
                   Rel_Env G r1 r2 ->
                   Rel o (env_lookup var r1) (env_lookup var r2).
Proof.
  induction G as [| o' G'];
    try false_invert.
  (* G = o':: G' *)
  induction var as [| G'' ? ? ? IHvar ];
    inversion 1; auto.
  apply IHvar.
  auto.
Qed.

Lemma lookup_preserves_Rel : forall G (o : Otype)
                       (var : Var G o)
                       (r : den_envM G)
                       (s : den_envS G),
    Rel_Env G r s -> Rel o (apply_env r var) (apply_env s var).
Proof.
  induction G; try false_invert.
  (* G = o' :: G' *)
  induction var.
  - (* var = var_0 *)
    inversion 1.
    auto.
  - (* var = var_S v' *)
    intros.
    apply IHvar.
    apply H.
Qed.

Lemma extend_env_preserves_Rel :
  forall G o r1 r2 val1 val2,
    Rel_Env G r1 r2 -> Rel o val1 val2 -> Rel_Env (o::G) (val1,r1) (val2,r2).
Proof.
  auto.
Qed.

Theorem Rel_strict2 : forall o1 o2 o3 d1 d1' d2 d2' f f',
    lift_Rel (Rel o1) d1 d1' ->
    lift_Rel (Rel o2) d2 d2' ->
    (forall v1 v1' v2 v2',
        Rel o1 v1 v1' -> Rel o2 v2 v2' -> lift_Rel (Rel o3) (f v1 v2) (f' v1' v2'))
    -> lift_Rel (Rel o3) (strict2 d1 d2 f) (strict2 d1' d2' f').
Proof.
  destruct d1, d1', d2, d2'; try false_invert; eauto.
Qed.

Theorem Rel_Return : forall m (v : den_typeS (Stype m)),
    Rel _ (returnopM v) (returnopS v).
Proof.
  autounfold; simpl.
  symmetry.
  auto using mu_L_const, times_one_weight.
Qed.

Theorem Rel_Uniform : Rel _ uniformopM uniformopS.
Proof.
  autounfold; simpl.
  auto using mu_L_extensional, times_one_weight.
Qed.

Lemma RelMeas_Lemma1 :
  forall (m : Mtype)
         (mu : (lifted (den_typeM (Meastype m))))
         (s  : (lifted (den_typeS (Meastype m))))
         k,
    lift_Rel (Rel (Meastype m)) mu s ->
    strict0 mu (fun mu' => (mu' k))
    = strict0 s (fun s' =>
                   (mu_L (fun u =>
                            strict20 (s' u) (fun b w =>
                                               (times w (k b)))))).
Proof.
  destruct mu, s;
    try false_invert;
    eauto.
Qed.

Lemma split_entropy_sampler : forall
    (o o' : Mtype)
    (mu : den_typeM (Meastype o))
    (s : den_typeS (Meastype o))
    (f : den_typeM (Stype o) -> lifted (den_typeM (Meastype o')))
    (f' : den_typeM (Stype o) -> lifted (den_typeS (Meastype o')))
    (k : den_Mtype o' -> real)
    (H0 : forall a : den_typeM (Stype o),
        lift_Rel (Rel (Meastype o')) (f a) (f' a)),

    mu_L (fun u =>
            (strict20 (s (left_half u))
                     (fun a w1 =>
                        (strict0 (f' a)
                                 (fun s2 =>
                                    (strict20 (s2 (right_half u))
                                              (fun b w2 =>
                                                 (times (prod_weights w1 w2)
                                                        (k b)))))))))
    =
    mu_L (fun u => (strict20 (s u)
                             (fun a w2 =>
                                (times w2
                                       (strict0 (f a)
                                                (fun mu' => mu' k)))))).
Proof.
  intros.
  rewrite <- (split_entropy
                (fun lu ru =>
                   strict20 (s lu)
                            (fun a w =>
                               (strict0 (f' a)
                                        (fun s2 =>
                                                 (strict20 (s2 ru) _)))))).
  apply mu_L_extensional; intro u.
  rewrite strict20_mu_L.
  f_equal.
  extensionality x.
  extensionality w.
  erewrite RelMeas_Lemma1 by auto. (* H0 is used here *)
  rewrite strict0_linear.
  rewrite strict0_mu_L.
  f_equal.
  extensionality x0.
  rewrite <- mu_L_linear.
  f_equal.
  extensionality u0.
  rewrite strict20_linear.
  f_equal.
  extensionality a.
  extensionality b.
  rewrite times_assoc.
  auto.
Qed.

Theorem Rel_bindop : forall (o o': Mtype) mu s
                            f f',
    Rel _ mu s ->
    (forall a, lift_Rel (Rel (Meastype o')) (f a) (f' a)) ->
    Rel _ (@bindopM o o' mu f) (@bindopS o o' s f').
Proof.
  intros.
  autounfold.
  intros.
  unfold bindopM.
  unfold Rel in H.
  rewrite H; clear H.
  erewrite <- split_entropy_sampler; auto.
  f_equal; extensionality u.
  rewrite strict20_strict2.
  f_equal. extensionality a. extensionality w.
  rewrite strict20_strict.
  f_equal. extensionality x.
  rewrite strict20_strict2.
  f_equal.
Qed.

Theorem Rel_distval : forall p, Rel (Meastype Real_type) (mu_1 p) (distvalS p).
Proof.
  intros.
  simpl.
  intros.
  rewrite mu_1_density_1.
  auto.
Qed.

Theorem Rel_obsval : forall p r,
    Rel (Meastype Empty_type) (obsvalM p r) (obsvalS p r).
Proof.
  intros.
  unfold Rel, obsvalM, obsvalS.
  intros.
  simpl.
  rewrite (mu_L_const (times (density_1 p r) (k tt))); auto.
Qed.

Definition Fun_Thm_Exp G o  (exp: Exp G o) :=
  forall
         (r : den_envM G)
         (s : den_envS G),
    Rel_Env G r s
    -> lift_Rel (@Rel o) (den_expM exp r) (den_expS exp s).
Hint Unfold Fun_Thm_Exp.

Definition Fun_Thm_Val G o  (val: Val G o) :=
  forall
         (r : den_envM G)
         (s : den_envS G),
    Rel_Env G r s
    -> Rel o (den_valM val r) (den_valS val s).
Hint Unfold Fun_Thm_Val.

Ltac auto_specialize :=
  repeat
    match goal with
    | [ H : forall x : ?a, _, v : ?a |- _ ] => specialize H with (x:=v)
    | [ H : ?a -> _, v : ?a |- _ ] =>
      let Hv := fresh H in
      apply H in v as Hv; clear H
    end.

Ltac destruct_lift :=
  match goal with
  | [ H : lift_Rel _ ?x _ |- _ ] =>
    match x with
    | bottom => fail 1
    | lift _ => fail 1
    | _ => (destruct x)
    end
  end.

Ltac invert_ex :=
  repeat
    match goal with
    | [ H : exists _, _ |- _ ] => inversion H; clear H; intuition
    end.

Ltac solve_ex := invert_ex; try (eexists; intuition).

Theorem Fund_Thm: forall G o exp, @Fun_Thm_Exp G o exp.
Proof.
  apply (exp_val_rec Fun_Thm_Exp Fun_Thm_Val);
    unfold Fun_Thm_Exp, Fun_Thm_Val;
    intros; simpl;
      eauto using lookup_preserves_Rel, extend_env_preserves_Rel,
      Rel_strict2, Rel_Return, Rel_Uniform, Rel_bindop,
      times_one_weight, mu_L_extensional, mu_1_density_1.

  - auto_specialize.
     destruct (den_expM e r), (den_expS e s), (den_expM e0 r), (den_expS e0 s);
      try false_invert;
      eauto using H2, H0.
     simpl.
     unfold lift_Rel.
     auto.

  (* proj1exp *)
  - auto_specialize.
    destruct (den_expM e r), (den_expS e s); try false_invert; auto.
    simpl.
    unfold lift_Rel in *.
    unfold Rel in *.
    simpl in *.
    apply H1.

      (* proj2exp *)
  - auto_specialize.
    destruct (den_expM e r), (den_expS e s); try false_invert; auto.
    simpl.
    unfold lift_Rel in *.
    unfold Rel in *.
    simpl in *.
    apply H1.

  (* appexp *)
  - (* specialize (H r s H1). *)
    (* specialize (H0 r s H1). *)
    auto_specialize.
    destruct (den_expM e r), (den_expS e s), (den_expM e0 r), (den_expS e0 s);
      try false_invert;
      eauto using H0,H2.

  (* appexp *)
  - auto_specialize.
    destruct (den_expM e r), (den_expS e s), (den_expM e0 r), (den_expS e0 s);
      try false_invert;
      auto.
    apply Rel_bindop; auto.
    intros.
    unfold lift_Rel in H0.
    unfold lift_Rel in H2.
    apply H2.
    unfold Rel.
    apply EqMtype_coerce.

  (* returnexp *)
  - specialize (H r s H0).
    destruct (den_expM e r), (den_expS e s);
      try false_invert;
      auto.
    apply EqMtype_injective in H; subst.
    apply Rel_Return.

  (* prodval *)
  - specialize (H r s H1).
    specialize (H0 r s H1).
    auto.

  (* distval *)
  - specialize (H r s H0).
    intros.
    rewrite H.
    apply Rel_distval.

    (* obsval *)
  - intros.
    specialize (H0 r s H1).
    specialize (H r s H1).
    simpl in *.
    unfold EqReal in *.
    rewrite H.
    rewrite H0.
    rewrite Rel_obsval.
    unfold obsvalS; simpl.
    auto.

  (* bindval *)
  - apply Rel_bindop; auto.
    intros.
    apply H0; auto.
    apply EqMtype_coerce.

  (* returnval *)
  - eapply EqMtype_injective in H; eauto.
    rewrite H.
    apply Rel_Return.
Qed.


Require Export D.
Require Export Lia.

(** **** Exercise: 2 stars (ins_SearchTree)  *)
(** This one is pretty easy, even without proof automation.
  Copy-paste your proof of insert_SearchTree from Extract.v.
  You will need to apply [balance_SearchTree] in two places.
 *)

(* Define hexploit tactic that was also used at merge_sort assignment *)
Lemma __mp__: forall P Q: Type, P -> (P -> Q) -> Q.
Proof. intuition. Defined.
Ltac hexploit H := eapply __mp__; [eapply H|].

Ltac gendep x := generalize dependent x.

Lemma ins_SearchTree:
forall x vx s lo hi,
                  lo <= int2Z x ->
                  int2Z x < hi ->
                  SearchTree' lo s hi ->
                  SearchTree' lo (ins x vx s) hi.
Proof.
  intros x vx s.
  induction s.
  { intros. simpl. constructor; constructor; nia. }
  { intros. simpl. inversion H1. subst.
    bdestruct (ltb x k).
    { apply balance_SearchTree; try assumption.
      eapply IHs1; try assumption; try nia. }
    { bdestruct (ltb k x).
      { apply balance_SearchTree; try assumption.
        eapply IHs2; try assumption; try nia. }
      { assert (HEQ: int2Z x = int2Z k). nia.
        constructor; rewrite HEQ in *; assumption.  }
    }
  }
Qed.


(* This file is distributed under the terms of the MIT License, also
   known as the X11 Licence.  A copy of this license is in the README
   file that accompanied the original distribution of this file.

   Based on code written by:
     Brian Aydemir *)

(** A library of code for supporting LNgen. *)

Require Export Metalib.LibDefaultSimp.
Require Import Metalib.Metatheory.
Require Import Omega.

(* ********************************************************************** *)
(** * Assorted functions not in the standard library *)

(** [lt_ge_dec] is a useful comparison operation when defining the
    "close" operation on locally nameless terms. *)

Definition lt_ge_dec (n m : nat) : {n < m} + {n >= m} :=
  match Compare_dec.le_gt_dec m n with
    | left pf => right pf
    | right pf => left pf
  end.

(* *********************************************************************** *)
(** * Tactics *)

(** [generalize_wrt x] is an ad hoc tactic that generalizes the goal
    with respect to everything that [x] does not depend on.  It seems
    to work only if [x] is the most recently introduced item into the
    context. *)

Ltac generalize_wrt x :=
  repeat (progress (match goal with
    | J : _ |- _ => move J after x; generalize dependent J
    end)).

(** [apply_mutual_ind] applies to the current goal a mutual induction
    principle that is stated in the form generated by [Combined
    Scheme].  It works even in degenerate cases, i.e., when there is
    no mutual induction, only simple induction.  It is intended to be
    used only at the start of a proof, and the argument(s) to induct
    over should come first. *)

Ltac apply_mutual_ind ind :=
  let H := fresh in
  first [ (* apply ind
        | *) intros H; induction H using ind
        | intros ? H; induction H using ind
        | intros ? ? H; induction H using ind
        | intros ? ? ? H; induction H using ind
        | intros ? ? ? ? H; induction H using ind
        | intros ? ? ? ? ? H; induction H using ind
        | intros ? ? ? ? ? ? H; induction H using ind
        | intros ? ? ? ? ? ? ? H; induction H using ind
        | intros ? ? ? ? ? ? ? ? H; induction H using ind
        ].

(** Renames the last hypothesis to the given identifier. *)

Ltac rename_last_into H :=
  match goal with
    | J : _ |- _ => rename J into H
  end.

(** Specializes every possible hypothesis with the given term. *)

Ltac specialize_all x :=
  repeat (match goal with
            | H : _ |- _ => specialize (H x)
          end).

(* *********************************************************************** *)
(** * Facts about finite sets *)

Lemma remove_union_distrib : forall (s1 s2 : atoms) (x : atom),
  remove x (union s1 s2) [=] union (remove x s1) (remove x s2).
Proof. fsetdec. Qed.

Lemma Equal_union_compat : forall (s1 s2 s3 s4 : atoms),
  s1 [=] s3 ->
  s2 [=] s4 ->
  union s1 s2 [=] union s3 s4.
Proof. fsetdec. Qed.

Lemma Subset_refl : forall (s : atoms),
  s [<=] s.
Proof. fsetdec. Qed.

Lemma Subset_empty_any : forall (s : atoms),
  empty [<=] s.
Proof. fsetdec. Qed.

Lemma Subset_union_compat : forall (s1 s2 s3 s4 : atoms),
  s1 [<=] s3 ->
  s2 [<=] s4 ->
  union s1 s2 [<=] union s3 s4.
Proof. fsetdec. Qed.

Lemma Subset_union_left : forall (s1 s2 s3 : atoms),
  s1 [<=] s2 ->
  s1 [<=] union s2 s3.
Proof. fsetdec. Qed.

Lemma Subset_union_right : forall (s1 s2 s3 : atoms),
  s1 [<=] s3 ->
  s1 [<=] union s2 s3.
Proof. fsetdec. Qed.

Lemma Subset_union_lngen_open_upper :
  forall (s1 s2 s3 s4 s5 : atoms),
  s1 [<=] union s3 s4 ->
  s2 [<=] union s3 s5 ->
  union s1 s2 [<=] union s3 (union s4 s5).
Proof. fsetdec. Qed.

(* *********************************************************************** *)
(** * Hints *)

Hint Resolve sym_eq : brute_force.

Hint Extern 5 (_ = _ :> nat) => omega : brute_force.
Hint Extern 5 (_ < _)        => omega : brute_force.
Hint Extern 5 (_ <= _)       => omega : brute_force.

Hint Rewrite @remove_union_distrib : lngen.

Hint Resolve @Equal_union_compat : lngen.
Hint Resolve @Subset_refl : lngen.
Hint Resolve @Subset_empty_any : lngen.
Hint Resolve @Subset_union_compat : lngen.
Hint Resolve @Subset_union_left : lngen.
Hint Resolve @Subset_union_right : lngen.
Hint Resolve @Subset_union_lngen_open_upper : lngen.


Require Import Shared.Base Shared.Bijection Shared.FiniteTypes.FinTypes.
Require Import Coq.Vectors.Fin.

Instance Fin_eq_dec n : eq_dec (Fin.t n).
Proof.
  intros; hnf.
  destruct (eqb x y) eqn:E.
  - left. now eapply eqb_eq.
  - right. intros H. eapply eqb_eq in H. congruence.
Defined.

Definition all_Fin n := nat_rec (fun n0 : nat => list (t n0)) [] (fun (n0 : nat) (IHn : list (t n0)) => F1 :: map FS IHn) n.

Lemma in_undup_iff (X: eqType) (A: list X) x : x el A <-> x el (undup A).
Proof.
  now rewrite undup_id_equi.
Qed.

(* (** * finTypes from Lists  *) *)
(* (* Conversion of lists over eqTypes to finite types *) *)
(* (* *) *)

(** * Pure predicates  *)
(* taken from the development of Herditarily finite sets by Prof. Smolka and Kathrin Stark. *)
(* *)

Definition pure (X:Type) (p: X -> Prop) {D:forall x, dec (p x)} x := if Dec (p x) then True else False.
Arguments pure {X} p {D} x.

Lemma pure_equiv  (X:Type) (p: X -> Prop) {D:forall x, dec (p x)} x : p x <-> pure p x.
Proof.
  unfold pure. now dec.
Qed.

Lemma pure_impure  (P: Prop) (_: dec P) (norm: if Dec (P) then True else False) : P.
Proof.
  dec; tauto.
Qed.
Ltac impurify H := pose proof (pure_impure H) as impureH; try (clear H; rename impureH into H).

Lemma purify (X: Type) (p: X -> Prop) (D:forall x, dec (p x)) x (px: p x): pure p x.
Proof.
  now  apply pure_equiv.
Qed.

Arguments purify {X} {p} {D} {x} px.

Lemma pure_eq (X: Type) (p: X -> Prop) (D: forall x, dec (p x)) x (p1 p2: pure p x) : p1 = p2.
Proof.
  unfold pure in *.  dec.
  + now destruct p1, p2.
  + contradiction p1.
Qed.

(* (** * Definition of subtypes *) *)

Definition subtype {X:Type} (p: X -> Prop) {D: forall x, dec (p x)} := { x:X | pure p x}.
Arguments subtype {X} p {D}.

Lemma subtype_extensionality (X: Type) (p: X -> Prop)  {D: forall x, dec (p x)} (x x': subtype p) : proj1_sig x = proj1_sig x' <-> x = x'.
Proof.
  split.
  - intros H. destruct x, x'. cbn in H. subst x0. f_equal. apply pure_eq.
  - congruence.
Qed.

Instance subType_eq_dec X (_:eq_dec X) (p: X -> Prop) (_: forall x, dec (p x)): eq_dec (subtype p).
Proof.
  intros y z. destruct y as [x p1], z as  [x' p2]. decide (x=x').
  - left.  now apply subtype_extensionality.
  - right. intro H. apply n. now inv H.
Qed.

(* Lemma proj1_sig_fun (X: eqType) (p: X -> Prop) (x x': X) (p1: p x) (p2: p x'): exist p x p1 = exist p x' p2 -> x = x'. *)
(* Proof. *)
(*   intro E. change x with (proj1_sig (exist p x p1)). change x' with (proj1_sig (exist p x' p2)). *)
(*   now inv E. *)
(* Qed. *)

(* (** * Subtypes from lists *) *)

(* Lemma in_undup_iff (X: eqType) (A: list X) x : x el A <-> x el (undup A). *)
(* Proof. *)
(*   now rewrite undup_id_equi. *)
(* Qed. *)

Fixpoint toSubList (X: Type) (A: list X) (p: X -> Prop) (D:forall x, dec (p x))  : list (subtype p) :=
  match A with
  | nil => nil
  | cons x A' => match Dec (p x) with
                | left px => (exist  _ x (purify px)) :: toSubList A' D
                | right _ => toSubList  A' _ end
  end.

Arguments toSubList {X} A p {D}.

Lemma toSubList_count (X: eqType) (p: X -> Prop) (A: list X) (_:forall x, dec (p x)) x:
  count (toSubList A p) x = count A (proj1_sig x).
Proof.
  induction A.
  - reflexivity.
  - cbn. decide (p a).
    + simpl. dec.
      * congruence.
      * now rewrite <- subtype_extensionality in e.
      * change a with (proj1_sig (exist (pure p) a (purify p0)))  in e. now rewrite subtype_extensionality in e.
      * exact IHA.
    + destruct x.  cbn. dec.
      * subst a. now impurify p0.
      * exact IHA.
Qed.

(* Lemma subType_enum_ok (X:finType) (p: X -> Prop) (_: forall x, dec (p x)) x: *)
(*   count (toSubList (elem X) p) x = 1. *)
(* Proof. *)
(*   rewrite toSubList_count. apply enum_ok. *)
(* Qed. *)

Notation "'Subtype' p"  := (finTypeC (EqType (subtype p))) (at level 5).

(* Instance finTypeC_sub (X:finType) (p: X -> Prop) (_:forall x, dec (p x)): Subtype p. *)
(* Proof. *)
(*   econstructor.  apply subType_enum_ok. *)
(* Defined. *)

(** * finTypes from Lists  *)
(* Conversion of lists over eqTypes to finite types *)
(* *)
Lemma enum_ok_fromList (X: eqType) (A: list X) x : count (undup (toSubList A (fun x => x el A))) x = 1.
Proof.
  apply dupfreeCount.
  - apply dupfree_undup.
  - rewrite <- in_undup_iff. apply countIn. cbn in *.
    rewrite toSubList_count.
    destruct x as [x p]. cbn. apply InCount. now impurify p.
Qed.

Instance fromListC (X: eqType) (A: list X) : Subtype (fun x => x el A).
Proof.
econstructor. intros [x p]. apply enum_ok_fromList.
Defined.

(* (* Canonical Structure finType_fromList (X: eqType) (A: list X) := FinType (EqSubType (fun x => x el A)). *) *)

(* (* Lemma finType_fromList_correct (X: eqType) (A: list X) : *) *)
(* (*   map (@proj1_sig _ _) (elem (finType_fromList A)) === A. *) *)
(* (* Proof. *) *)
(* (*   cbn. split. *) *)
(* (*   -  intros x H. destruct (in_map_iff (@proj1_sig _ _) (undup (toSubList A (fun x => x el A))) x) as [H0 _]. *) *)
(* (*      specialize (H0 H). destruct H0 as [[y p] [E _]]. cbn in *. subst y. now impurify p. *) *)
(* (*   - intros x H. apply in_map_iff. *) *)
(* (*     eexists. Unshelve. Focus 2. *) *)
(* (*     + exists x. unfold pure. now dec. *) *)
(* (*     + cbn. split; auto. apply countIn with (A:= undup (toSubList A _)). rewrite enum_ok_fromList. omega. *) *)
(* (* Qed. *) *)

(*   Definition finType_of := {x : X | x el A}. *)

(*   Lemma eqType_finType_of : eq_dec finType_of. *)
(*   Proof. *)
(*     eapply subType_eq_dec. *)

  (* Lemma enum_ok_fromList (X: eqType) (A: list X) x : count (undup (toSubList A (fun x => x el A))) x = 1. *)
  (* Proof. *)
  (*   apply dupfreeCount. *)
  (*   - apply dupfree_undup. *)
  (*   - rewrite <- in_undup. apply countIn. rewrite toSubList_count. *)
  (*     destruct x as [x p]. cbn. apply InCount. now impurify p. *)
  (* Qed. *)

(* Instance fromListC (X: eqType) (A: list X) : finTypeC (EqSubType (fun x => x el A)). *)
(* Proof. *)
(* econstructor. intros [x p]. apply enum_ok_fromList. *)
(* Defined. *)

(* Canonical Structure finType_fromList (X: eqType) (A: list X) := FinType (EqSubType (fun x => x el A)). *)

(* Lemma finType_fromList_correct (X: eqType) (A: list X) : *)
(*   map (@proj1_sig _ _) (elem (finType_fromList A)) === A. *)
(* Proof. *)
(*   cbn. split. *)
(*   -  intros x H. destruct (in_map_iff (@proj1_sig _ _) (undup (toSubList A (fun x => x el A))) x) as [H0 _]. *)
(*      specialize (H0 H). destruct H0 as [[y p] [E _]]. cbn in *. subst y. now impurify p. *)
(*   - intros x H. apply in_map_iff. *)
(*     eexists. Unshelve. Focus 2. *)
(*     + exists x. unfold pure. now dec. *)
(*     + cbn. split; auto. apply countIn with (A:= undup (toSubList A _)). rewrite enum_ok_fromList. omega. *)
(* Qed.  *)


Require Import List.

Require Import Logic.Class.Eq.

Require Import Logic.Func.Replace.
Require Import Logic.Func.Permute.
Require Import Logic.Func.Identity.
Require Import Logic.Func.Composition.

Require Import Logic.List.In.
Require Import Logic.List.Coincide.
Require Import Logic.List.InjectiveOn.

Lemma replace_trans : forall (v:Type) (e:Eq v) (x y z:v) (ys:list v),
    ~ y :: ys -> coincide ys ((z // y) ; (y // x)) (z // x).
Proof.
    intros v e x y z ys H u H'. unfold comp.
    destruct (eqDec u x) as [Hux|Hux],
             (eqDec u y) as [Huy|Huy],
             (eqDec u z) as [Huz|Huz]; subst.
    - rewrite replace_x_x. reflexivity.
    - rewrite replace_x_x. reflexivity.
    - rewrite replace_x_x, replace_x, replace_x. reflexivity.
    - rewrite replace_x, replace_x, replace_x. reflexivity.
    - rewrite replace_x_x. reflexivity.
    - exfalso. apply H. assumption.
    - rewrite replace_y.
      assert (replace x y z = z) as E.
        { rewrite replace_not_x. reflexivity. assumption. }
      rewrite E. rewrite replace_y. reflexivity.
    - assert (replace x y u = u) as E.
        { rewrite replace_not_x. reflexivity. assumption. }
      rewrite E. rewrite replace_not_x, replace_not_x.
          + reflexivity.
          + assumption.
          + assumption.
Qed.

Lemma replace_inj : forall (v:Type) (e:Eq v) (x y:v) (ys:list v),
    ~ y :: ys -> injective_on ys (y // x).
Proof.
    intros v e x y ys Hy s t Hs Ht H.
    destruct (eqDec s x) as [Hsx|Hsx], (eqDec t x) as [Htx|Htx]; subst.
    - reflexivity.
    - rewrite replace_x in H.
      rewrite replace_not_x in H.
        + subst. exfalso. apply Hy, Ht.
        + assumption.
    - rewrite replace_x in H.
      rewrite replace_not_x in H.
        + subst. exfalso. apply Hy, Hs.
        + assumption.
    - rewrite replace_not_x in H.
        + rewrite replace_not_x in H; assumption.
        + assumption.
Qed.

Lemma replace_permute : forall (v:Type) (e:Eq v) (x y:v) (ys: list v),
    ~ y :: ys -> coincide ys (y // x) (y <:> x).
Proof.
    intros v e x y ys H. unfold coincide. intros u H'.
    destruct    (eqDec u x) as [Hux|Hux] eqn:Eux,
                (eqDec u y) as [Huy|Huy] eqn:Euy;
    subst; unfold permute, replace.
    - exfalso. apply H. assumption.
    - destruct (eqDec x x) as [Hxx|Hxx].
        + reflexivity.
        + destruct (eqDec x y); reflexivity.
    - exfalso. apply H. assumption.
    - rewrite Eux, Euy. reflexivity.
Qed.


(* -*- coq-prog-args: ("-emacs-U" "-R" "." "FingerTree" "-R" "../safe" " "-R" "../monads" " "-debug"); compile-command: "./makedoc.sh" -*- *)
(* begin hide *)
Require Import Monoid.
(* end hide *)
(** Suppose we want to define the monoid $(0, +)$ on naturals. We have to apply the [mkMonoid]
   constructor to [0], [plus] and proofs of identity and associativity. Fortunately, those can be filled
   automatically by Coq.
   The $\coqdockw{Program}$ modifier simply indicates we want to call the Russell type-checker,
   the '@' symbol is used to bypass the implicit argument mechanism and the underscores are
   holes which will be automatically turned into obligations by the type-checker.
   *)

Program Definition plus_monoid := @mkMonoid nat 0 plus _ _ _.


(* Gabriel Braun April 2013 *)

Require Export GeoCoq.Tarski_dev.Ch13_5_Pappus_Pascal.

Section Desargues_Hessenberg.

Context `{TE:Tarski_euclidean}.

Lemma l13_15_1 : forall A B C A' B' C' O,
  ~ Col A B C -> ~ Par O B A C -> Coplanar O B A C ->
  Par_strict A B A' B' -> Par_strict A C A' C'->
  Col O A A' -> Col O B B' -> Col O C C' ->
  Par B C B' C'.
Proof.
    intros.
    assert(~Col B A' B').
      intro.
      apply H2.
      exists B.
      split; Col.
    assert(~Col A A' B').
      intro.
      apply H2.
      exists A.
      split; Col.
    assert(B <> O).
      intro.
      subst B.
      apply H2.
      exists A'.
      split; Col.
    assert(A <> O).
      intro.
      subst A.
      apply H2.
      exists B'.
      split; Col.
    assert(~ Col A' A C).
      eapply (par_not_col A' C').
        Par.
      Col.
    assert(C <> O).
      intro.
      subst C.
      apply H11.
      Col.
    assert(~Col O A B).
      intro.
      apply H2.
      exists O.
      split.
        Col.
      assert(Col O A B').
        apply (col_transitivity_1 _ B); Col.
      apply (col_transitivity_1 _ A); Col.
    assert(~Col O A C).
      intro.
      apply H3.
      exists O.
      split.
        Col.
      assert(Col O A C').
        apply (col_transitivity_1 _ C); Col.
      apply (col_transitivity_1 _ A); Col.
    assert(~ Col A' B' C').
      intro.
      apply H.
      assert(Par A' C' A B).
        apply(par_col_par_2 A' B' A B C').
          apply par_strict_distinct in H3.
          spliter.
          auto.
          auto.
        left.
        Par.
      assert(Par A C A B).
        apply(par_trans A C A' C'); Par.
      induction H17.
        apply False_ind.
        apply H17.
        exists A.
        split; Col.
      spliter; Col.
    induction(col_dec O B C).
      right.
      repeat split.
        intro.
        subst C.
        apply H.
        Col.
        intro.
        subst C'.
        apply H15.
        Col.
        assert(Col O B C').
          apply (col_transitivity_1 _ C); Col.
        apply (col_transitivity_1 _ O); Col.
      assert(Col O C B').
        apply (col_transitivity_1 _ B); Col.
      apply (col_transitivity_1 _ O); Col.
    assert(B' <> O).
      intro.
      subst B'.
      apply H8.
      Col.
    assert(B' <> O).
      intro.
      subst B'.
      apply H8.
      Col.
    assert(A' <> O).
      intro.
      subst A'.
      apply H7.
      Col.
    assert(~ Col A A' C').
      apply (par_not_col A C).
        Par.
      Col.
    assert(C' <> O).
      intro.
      subst C'.
      apply H20.
      Col.
    assert(~Col O A' B').
      intro.
      apply H2.
      exists O.
      split.
        assert(Col O A' B).
          apply (col_transitivity_1 _ B'); Col.
        apply (col_transitivity_1 _ A'); Col.
      Col.
    assert(~Col O A' C').
      intro.
      apply H3.
      exists O.
      split.
        ColR.
      Col.
    assert(~Col B' A B).
      intro.
      apply H2.
      exists B'.
      Col.
    assert(~Col A' A B).
      intro.
      apply H2.
      exists A'.
      split; Col.
    (********** construct L *********)
    assert(exists C : Tpoint, exists D : Tpoint, C <> D /\ Par O B C D /\ Col A C D).
      apply(parallel_existence O B A).
      auto.
    ex_and H26 X.
    ex_and H27 Y.
    assert(Coplanar O B X A) by (apply col_cop__cop with Y; Col; Cop).
    assert(Coplanar O B Y A) by (apply col_cop__cop with X; Col; Cop).
    assert(exists L : Tpoint, Col L X Y /\ Col L A' C').
      apply(cop_npar__inter_exists X Y A' C').
      apply coplanar_pseudo_trans with O A B; [Cop..|].
        apply coplanar_perm_12, col_cop__cop with C; Cop.
      intro.
      apply H0.
      eapply (par_trans O B X Y).
        auto.
      apply par_symmetry.
      apply (par_trans A C A' C').
        left.
        auto.
      Par.
    ex_and H31 L.
    assert(A <> L).
      intro.
      subst L.
      contradiction.
    assert(Par A L O B').
      apply par_symmetry.
      apply(par_col_par_2 _ B); Col.
      apply par_symmetry.
      apply par_left_comm.
      induction(eq_dec_points X L).
        subst X.
        apply (par_col_par_2 _ Y); Col.
        Par.
      apply (par_col_par_2 _ X); try auto.
        ColR.
      apply par_left_comm.
      apply (par_col_par_2 _ Y); Col.
      Par.
    (********** construct M *********)
    assert(~ Par X Y O C).
      intro.
      assert(Par O B O C).
        apply (par_trans O B X Y); Par.
      induction H36.
        apply H36.
        exists O.
        split; Col.
      spliter.
      apply H16.
      Col.
    assert(Coplanar X Y O C).
      apply coplanar_pseudo_trans with O A B; Cop.
    assert(HH:=cop_npar__inter_exists X Y O C H36 H35).
    ex_and HH M.
    assert(A <> M).
      intro.
      subst M.
      apply H14.
      Col.
    assert(Par O B A M).
      apply (par_col_par_2 _ B'); Col.
      apply par_symmetry.
      apply (par_col_par_2 _ L); try auto.
      ColR.
    (*************** construct N ********************)
    assert(L <> A').
      intro.
      subst L.
      clean_trivial_hyps.
      apply H13.
      induction(eq_dec_points A' X).
        subst X.
        assert(Par A' A O B).
          apply (par_col_par_2 _ Y); Col.
          Par.
        induction H32.
          apply False_ind.
          apply H32.
          exists O.
          split; Col.
        spliter.
        ColR.
      assert(Par X A' O B).
        apply (par_col_par_2 _ Y); Col.
        Par.
      assert(Par A' A O B).
        apply (par_col_par_2 _ X); try auto.
          ColR.
        Par.
      induction H42.
        apply False_ind.
        apply H42.
        exists O.
        split; Col.
      spliter.
      Col.
    assert(~ Par L B' A' B').
      intro.
      induction H42.
        apply H42.
        exists B'.
        split;Col.
      spliter.
      apply H15.
      eapply (col_transitivity_1 _ L); Col.
    assert(~ Par A B L B').
      apply(par_not_par A' B' A B L B').
        left.
        Par.
      intro.
      apply H42.
      Par.
    assert(Coplanar A B L B').
      apply coplanar_perm_4, col_cop__cop with O; Col; Cop.
    assert(HH:=cop_npar__inter_exists A B L B' H44 H43).
    ex_and HH N.
    assert(Par_strict A L O B').
      induction H34.
        auto.
      spliter.
      apply False_ind.
      apply H13.
      apply (col_transitivity_1 _ B'); Col.
    assert(A <> N).
      intro.
      subst N.
      apply H47.
      exists B'; Col.
    assert(Par A N A' B').
      apply (par_col_par_2 _ B); Col.
      left.
      Par.
    clean_duplicated_hyps.
    (**********************************)
    assert(Par O N L A').
      induction(par_dec A O N L).
        assert(Par_strict A O N L).
          induction H18.
            auto.
          spliter.
          apply False_ind.
          apply H24.
          assert(Col N A B').
            eapply (col_transitivity_1 _ L); Col.
          apply col_permutation_2.
          eapply (col_transitivity_1 _ N); Col.
        apply(l13_14 A O A' A N L N B'); Col.
          Par.
        Par.
      assert(N <> L).
        intro.
        subst L.
        apply H47.
        exists B.
        split; Col.
      assert(Coplanar A O N L).
        assert_diffs; apply coplanar_perm_1, col_cop__cop with B'; Col; Cop.
      assert(HH:=cop_npar__inter_exists A O N L H51 H18).
      ex_and HH P.
      apply par_right_comm.
      assert(P <> L).
        intro.
        subst P.
        apply H47.
        exists O.
        split; Col.
      assert(P <> O).
        intro.
        subst P.
        apply H47.
        exists L.
        split.
          Col.
        apply (col_transitivity_1 _ N); Col.
      assert(L <> B').
        intro.
        subst L.
        apply H47.
        exists B'.
        split; Col.
      assert(A <> P).
        intro.
        subst P.
        assert(Col A B L).
          apply (col_transitivity_1 _ N); Col.
        assert(Col L A B').
          apply (col_transitivity_1 _ N); Col.
        apply H43.
        apply par_symmetry.
        right.
        repeat split.
          assumption.
          intro.
          subst B.
          apply H24.
          Col.
          Col.
        ColR.
      assert(P <> N).
        intro.
        subst P.
        apply H13.
        apply col_permutation_2.
        apply (col_transitivity_1 _ N); Col.
      assert(A' <> P).
        intro.
        subst P.
        apply H42.
        right.
        repeat split; try assumption.
          intro.
          subst B'.
          apply H22.
          Col.
          ColR.
        Col.
      assert(B' <> P).
        intro.
        subst P.
        apply H22.
        apply (col_transitivity_1 _ A); Col.
      apply(l13_11 O A' A L N B' P); Par; try ColR.
      intro.
      apply H47.
      exists L.
      split.
        Col.
      assert(Col L O N).
        apply (col_transitivity_1 _ P); Col.
      apply (col_transitivity_1 _ N); Col.
    (* apply col_permutation_2.
    apply (col_transitivity_1 _ A); Col.
    apply col_permutation_1.
    apply (col_transitivity_1 _ O); Col.
    Col.
    apply col_permutation_2.
    apply (col_transitivity_1 _ L); Col.
    *)
    assert(Par A' C' O N).
      apply (par_col_par_2 _ L).
        intro.
        subst C'.
        apply H23.
        Col.
        Col.
      Par.
    assert(Par O N A C).
      apply (par_trans _ _ A' C'); Par.
    assert(Par N M B C).
      induction(par_dec A N O C).
        assert(Par_strict A N O C).
          induction H52.
            auto.
          spliter.
          apply False_ind.
          apply H14.
          Col.
        apply par_right_comm.
        apply(l13_14 A N B A O C M O ); Par; Col.
      assert(Coplanar A N O C) by Cop.
      assert(HH:= cop_npar__inter_exists A N O C H53 H52).
      ex_and HH P.
      assert(B <> P).
        intro.
        subst P.
        apply H16.
        Col.
      assert(A <> P).
        intro.
        subst P.
        apply H14.
        Col.
      assert(M <> P).
        intro.
        subst P.
        induction H40.
          apply H40.
          exists B.
          split.
            Col.
          apply col_permutation_2.
          apply (col_transitivity_1 _ N); Col.
        spliter.
        apply H13.
        apply col_permutation_2.
        apply (col_transitivity_1 _ M); Col.
      assert(O <> P).
        intro.
        subst P.
        induction H51.
          apply H51.
          exists A.
          split; Col.
        spliter.
        apply H14.
        Col.
      assert(P <> N).
        intro.
        subst P.
        induction H51.
          apply H51.
          exists C.
          split; Col.
        spliter.
        apply H14.
        Col.
      apply(l13_11 N B A C M O P); Par; try ColR.
      intro.
      assert(Col N A C) by ColR.
      apply H.
      ColR.
    (* apply col_permutation_2.
    apply (col_transitivity_1 _ A); Col.
    apply col_permutation_1.
    apply (col_transitivity_1 _ N); Col.
    apply col_permutation_2.
    apply (col_transitivity_1 _ O); Col.
    apply col_permutation_1.
    apply (col_transitivity_1 _ C); Col.
    *)
    assert(Par N M B' C').
      induction(par_dec N B' O C').
        assert(Par_strict N B' O C').
          induction H53.
            auto.
          spliter.
          apply False_ind.
          induction H51.
            apply H51.
            exists C.
            split.
              ColR.
            Col.
          spliter.
          contradiction.
        assert(M <> L).
          intro.
          subst M.
          apply H54.
          exists L.
          split.
            Col.
          apply col_permutation_2.
          apply(col_transitivity_1 _ C); Col.
        assert(L <> C').
          intro.
          subst C'.
          apply H54.
          exists L.
          split; Col.
        assert(Par L M O B').
          apply (par_col_par_2 _ A); try assumption.
            auto.
            ColR.
          Par.
        assert(Par L C' O N).
          apply (par_col_par_2 _ A'); Col.
          Par.
        apply par_right_comm.
        apply(l13_14 B' N B' L O C' M O); Par; ColR.
      assert(Coplanar N B' O C').
        apply coplanar_pseudo_trans with O A B; [Cop..|].
        apply coplanar_perm_12, col_cop__cop with C; Col; Cop.
      assert(HH:= cop_npar__inter_exists N B' O C' H54 H53).
      ex_and HH P.
      assert(B' <> P).
        intro.
        subst P.
        apply H16.
        ColR.
      induction(eq_dec_points C'  L).
        subst L.
        assert(C' = M).
          induction (col_dec O X C).
            apply (l6_21 O C Y X).
              intro.
              assert(Col O X Y) by ColR.
              induction H27.
                apply H27.
                exists O.
                split; Col.
              spliter.
              apply H13.
              apply(col3 X Y); Col.
              auto.
              Col.
              Col.
              Col.
              Col.
          apply (l6_21 O C X Y); Col.
        subst M.
        right.
        repeat split; auto.
          apply par_distincts in H52; spliter; auto.
          intro; subst; apply H15; Col.
          Col.
        Col.
      assert(L <> P).
        intro.
        subst P.
        apply H23.
        apply col_permutation_1.
        apply (col_transitivity_1 _ L); Col.
      induction (eq_dec_points L M).
        subst L.
        assert(C' = M).
          apply (l6_21 O C A' C'); Col.
            intro.
            apply H23.
            ColR.
            intro.
            subst C'.
            apply H23.
            Col.
            subst M.
            right.
            repeat split; auto. Col. Col.
              assert(Par L M O B').
            apply (par_col_par_2 _ A); try assumption. ColR.
              Par.
            assert(Par L C' N O).
              apply (par_col_par_2 _ A'); Col.
              Par.
            assert(B' <> N).
              intro.
              subst N.
              contradiction.
            apply(l13_11  N B' L  C' M O P); Par.
              intro.
              assert(Col P B' C').
                apply (col_transitivity_1 _ N).
                  intro.
                  subst N.
                  induction H50.
                    apply H50.
                    exists C'.
                    split; Col.
                  spliter.
                  apply H23.
                  ColR.
                  Col.
                Col.
              assert(Col C' O B' ).
                apply (col_transitivity_1 _ P).
                  intro.
                  subst P.
                  clean_trivial_hyps.
                  assert(Col B' C' L).
                    apply (col_transitivity_1 _ N); Col.
                  apply H15.
                  ColR.
                  Col.
                Col.
              assert(Col O B C').
                apply (col_transitivity_1 _ B'); Col.
              apply H16.
              ColR.
              ColR.
              intro.
              subst M.
              assert(Col B' P L).
                apply (col_transitivity_1 _ N); Col.
              assert(Col L A B').
                assert(Col P A L).
                  apply (col3 X Y); Col.
                apply (col_transitivity_1 _ P); Col.
              apply H47.
              exists B'.
              split; Col.
              intro.
              subst P.
              assert(N = B).
                apply (l6_21 A B O B'); Col.
                  subst N.
                  induction H52.
                    apply H52.
                    exists B.
                    split; Col.
                  spliter.
                  assert(B = O).
                    apply (l6_21 O B' M C); Col.
                  subst B.
                  induction H61.
                    apply H61.
                    exists L.
                    split; Col.
                  tauto.
                  ColR.
                  ColR.
                  apply (par_trans _ _ N M); Par.
Qed.

Lemma l13_15_2_aux : forall A B C A' B' C' O , ~Col A B C
                                         -> ~Par O A B C
                                         -> Par O B A C
                                         -> Par_strict A B A' B'
                                         -> Par_strict A C A' C'
                                         -> Col O A A' -> Col O B B' -> Col O C C'
                                         -> Par B C B' C'.
Proof.
    intros.
    assert(~Col O A B /\ ~Col O B C /\ ~Col O A C).
      induction H1; repeat split; intro.
        apply H1.
        exists A.
        split; Col.
        apply H1.
        exists C.
        split; Col.
        apply H1.
        exists O.
        split; Col.
        spliter.
        apply H; Col.
        spliter.
        apply H; Col.
      spliter.
      apply H; Col.
    spliter.
    assert( A <> O /\ B <> O /\ C <> O).
      repeat split; intro; subst O.
        apply H9.
        Col.
        apply H8.
        Col.
      apply H9.
      Col.
    spliter.
    assert( A' <> O).
      intro.
      subst A'.
      assert(Par O B A B).
        apply (par_col_par_2 _ B'); Col.
        left.
        Par.
      induction H13.
        apply H13.
        exists B.
        split; Col.
      spliter.
      contradiction.
    assert(B' <> O).
      intro.
      subst B'.
      assert(Par O A B A).
        apply(par_col_par_2 _ A'); Col.
        apply par_comm.
        apply par_symmetry.
        left.
        Par.
      induction H14.
        apply H14.
        exists A.
        split; Col.
      spliter.
      apply H7.
      Col.
    assert(C' <> O).
      intro.
      subst C'.
      assert(Par O A C A).
        apply (par_col_par_2 _ A'); Col.
        apply par_comm.
        apply par_symmetry.
        left.
        Par.
      induction H15.
        apply H15.
        exists A.
        split; Col.
      spliter.
      apply H9.
      Col.
    assert(~Col O A' B').
      intro.
      assert(Col O A B').
        apply (col_transitivity_1 _ A'); Col.
      apply H7.
      apply (col_transitivity_1 _ B'); Col.
    assert(~Col O B' C').
      intro.
      assert(Col O B C').
        apply (col_transitivity_1 _ B'); Col.
      apply H8.
      apply (col_transitivity_1 _ C'); Col.
    assert(~Col O A' C').
      intro.
      assert(Col O A C').
        apply (col_transitivity_1 _ A'); Col.
      apply H9.
      apply (col_transitivity_1 _ C'); Col.
    assert(A <> A').
      intro.
      subst A'.
      apply H3.
      exists A.
      split; Col.
    assert(B <> B').
      intro.
      subst B'.
      apply H2.
      exists B.
      split; Col.
    assert(C <> C').
      intro.
      subst C'.
      apply H3.
      exists C.
      split; Col.
    induction(par_dec B C B' C').
      auto.
    assert(B <> C).
      intro.
      subst C.
      apply H.
      Col.
    assert(HP:=parallel_existence B C B' H23).
    ex_and HP X.
    ex_and H24 Y.
    assert(~Par X Y O C).
      intro.
      assert(Par O C B C).
        apply (par_trans _ _  X Y); Par.
      induction H28.
        apply H28.
        exists C.
        split; Col.
      spliter.
      contradiction.
    assert(Coplanar X Y O C).
      induction H25.
        apply coplanar_pseudo_trans with B C B'.
          apply not_col_permutation_1, (par_not_col X Y); Par.
          apply coplanar_perm_1, col_cop__cop with Y; Col; Cop.
          apply coplanar_perm_1, col_cop__cop with X; Col; Cop.
          Cop.
          Cop.
      spliter.
      Cop.
    assert(HH:=cop_npar__inter_exists X Y O C H28 H27).
    ex_and HH C''.
    assert(B' <> C'').
      intro.
      subst C''.
      assert(Col O B C).
        apply (col_transitivity_1 _ B'); Col.
      contradiction.
    assert(Par B' C'' B C ).
      induction(eq_dec_points B' X).
        subst X.
        apply (par_col_par_2 _ Y).
          auto.
          Col.
        Par.
      apply (par_col_par_2 _ X).
        auto.
        apply col_permutation_2.
        apply(col_transitivity_1 _ Y); Col.
      apply par_left_comm.
      apply (par_col_par_2 _ Y); Col.
      Par.
    assert(Par A C A' C'').
      apply(l13_15_1 B A C B' A' C'' O); Col.
        Cop.
        apply par_strict_comm.
        auto.
      induction H32.
        Par.
      spliter.
      apply False_ind.
      apply H8.
      apply col_permutation_2.
      apply(col_transitivity_1 _ B'); Col.
    assert(C' <> C'').
      intro.
      subst C''.
      apply H22.
      Par.
    assert(Par A' C' A' C'').
      apply (par_trans _ _ A C).
        left.
        Par.
      Par.
    assert(C' = C'').
      apply (l6_21 A' C' O C); Col.
        induction H35.
        apply False_ind.
        apply H35.
        exists A'.
        split; Col.
        spliter.
        Col.
    contradiction.
Qed.

Lemma l13_15_2 : forall A B C A' B' C' O , ~Col A B C
                                         -> Par O B A C
                                         -> Par_strict A B A' B'
                                         -> Par_strict A C A' C'
                                         -> Col O A A' -> Col O B B' -> Col O C C'
                                         -> Par B C B' C'.
Proof.
    intros.
    induction(par_dec B C B' C').
      auto.
    assert(HH:=not_par_one_not_par B C B' C' O A H6).
    induction HH.
      apply (l13_15_2_aux A B C A' B' C' O); auto.
      intro.
      apply H7.
      Par.
    apply par_symmetry.
    assert(~ Col A' B' C').
      intro.
      apply H.
      assert(Par A' B' A' C').
        right.
        repeat split; Col.
          intro.
          subst B'.
          apply H1.
          exists A.
          split; Col.
        intro.
        subst C'.
        apply H2.
        exists A.
        split; Col.
      assert(Par A B A C).
        apply(par_trans _ _ A' B').
          left.
          auto.
        apply(par_trans _ _ A' C').
          Par.
        left.
        Par.
      induction H10.
        apply False_ind.
        apply H10.
        exists A.
        split; Col.
      spliter.
      Col.
    assert(B' <> O).
      intro.
      subst B'.
      assert(Par O A B A).
        apply (par_col_par_2 _ A'); Col.
          intro.
          subst A.
          apply H1.
          exists O.
          split; Col.
        apply par_comm.
        left.
        Par.
      induction H9.
        apply H9.
        exists A.
        split; Col.
      spliter.
      apply H1.
      exists O.
      split; Col.
    assert(Par O B O B').
      right.
      repeat split; Col.
      intro.
      subst B.
      apply par_distincts in H0.
      tauto.
    apply (l13_15_2_aux A' B' C' A B C O); Col; Par.
      intro.
      apply H7.
      apply par_symmetry.
      apply (par_col_par_2 _ A').
        intro.
        subst A.
        induction H0.
          apply H0.
          exists O.
          split; Col.
        spliter.
        apply H.
        Col.
        Col.
      Par.
    apply (par_trans _ _ O B).
      Par.
    apply (par_trans _ _ A C).
      Par.
    left.
    Par.
Qed.

Lemma l13_15 : forall A B C A' B' C' O , ~Col A B C -> Coplanar O B A C
                                         -> Par_strict A B A' B'
                                         -> Par_strict A C A' C'
                                         -> Col O A A' -> Col O B B' -> Col O C C'
                                         -> Par B C B' C'.
Proof.
    intros.
    induction(par_dec O B A C).
      apply (l13_15_2 A B C A' B' C' O); Col; Par.
    apply (l13_15_1 A B C A' B' C' O); Col; Par.
Qed.

Lemma l13_15_par : forall A B C A' B' C', ~Col A B C
                                         -> Par_strict A B A' B'
                                         -> Par_strict A C A' C'
                                         -> Par A A' B B'
                                         -> Par A A' C C'
                                         -> Par B C B' C'.
Proof.
    intros.
    assert(Plg B' A' A B).
      apply(pars_par_plg B' A' A B).
        apply par_strict_left_comm.
        Par.
      Par.
    apply plg_to_parallelogram in H4.
    apply plg_permut in H4.
    assert(Plg  A' C' C A).
      apply(pars_par_plg  A' C' C A).
        apply par_strict_right_comm.
        Par.
      Par.
    apply plg_to_parallelogram in H5.
    apply plg_permut in H5.
    assert(Parallelogram B B' C' C \/ B = B' /\ A' = A /\ C = C' /\ B = C).
      apply(plg_pseudo_trans B B' A' A C C').
        apply plg_sym.
        auto.
      apply plg_comm2.
      apply plg_permut.
      apply plg_permut.
      auto.
    assert(Par B B' C C').
      apply (par_trans _ _ A A'); Par.
    induction H7.
      induction H6.
        assert(B <> B').
          apply par_distincts in H2.
          tauto.
        apply plg_par in H6.
          spliter.
          Par.
          auto.
        intro.
        subst C'.
        apply H7.
        exists B'.
        split; Col.
      spliter.
      subst C.
      subst C'.
      apply False_ind.
      apply H7.
      exists B.
      split; Col.
    induction H6.
      apply plg_par in H6.
        spliter.
        Par.
        spliter.
        auto.
      spliter.
      intro.
      subst C'.
      assert(Par A B A C).
        apply (par_trans _ _ A' B'); left; Par.
      induction H11.
        apply H11.
        exists A.
        split; Col.
      spliter.
      apply H.
      Col.
    spliter.
    subst B'.
    subst A'.
    subst C'.
    subst C.
    apply False_ind.
    apply H1.
    exists A.
    split; Col.
Qed.

Lemma l13_18_2 : forall A B C A' B' C' O, ~Col A B C
                               -> Par_strict A B A' B'
                               -> Par_strict A C A' C'
                               -> (Par_strict B C B' C' /\ Col O A A' /\ Col O B B' -> Col O C C').
Proof.
    intros.
    spliter.
    assert(~ Col O A B).
      intro.
      apply H0.
      exists O.
      split.
        Col.
      apply(col_transitivity_1 _ A); Col.
        intro.
        subst A.
        apply H0.
        exists B'.
        split; Col.
      apply(col_transitivity_1 _ B); Col.
      intro.
      subst B.
      apply H0.
      exists A'.
      split; Col.
    assert(exists X : Tpoint, Col X B' C' /\ Col X O C).
      apply cop_npar__inter_exists.
        assert_diffs; apply coplanar_perm_13, col_cop__cop with B; Col; Cop.
      apply par_not_par with B C; Par.
      intro.
      induction H6.
        apply H6.
        exists C.
        split; Col.
      spliter.
      apply H2.
      exists B'.
      split;Col.
      apply col_permutation_2.
      apply (col_transitivity_1 _ O); Col.
      intro.
      subst O.
      apply H0.
      exists A'.
      split; Col.
    ex_and H6 C''.
    induction(col_dec O C C').
      auto.
    apply False_ind.
    assert(Par C' C'' B C ).
      apply (par_col_par_2 _ B').
        intro.
        subst C''.
        Col.
        Col.
      apply par_left_comm.
      left.
      Par.
    assert(Par_strict C' C'' B C).
      induction H9.
        auto.
      spliter.
      apply False_ind.
      apply H8.
      apply col_permutation_2.
      apply (col_transitivity_1 _ C'').
        intro.
        subst C''.
        apply H2.
        exists C.
        split; Col.
        apply (col_transitivity_1 _ B); Col.
      Col.
    assert(~Col O B C).
      intro.
      apply H10.
      exists B'.
      split; Col.
      apply col_permutation_2.
      apply (col_transitivity_1 _ O); Col.
      intro.
      subst B.
      apply H5.
      Col.
    assert(Par B' C'' B C).
      apply (par_col_par_2 _ C') ; Col.
        intro.
        subst B'.
        apply H11.
        apply(col_transitivity_1 _ C''); Col.
        intro.
        subst C''.
        apply H0.
        exists A.
        split; Col.
      left.
      Par.
    assert(Par_strict B' C'' B C).
      induction H12.
        auto.
      spliter.
      apply False_ind.
      apply H11.
      apply col_permutation_2.
      apply (col_transitivity_1 _ B'); Col.
      intro.
      subst B'.
      apply H2.
      exists B.
      split; Col.
    assert(Par A C A' C'').
      apply(l13_15 B A C B' A' C'' O); Par; Col.
      assert_diffs; apply coplanar_perm_3, coplanar_trans_1 with C'; Col.
        apply coplanar_perm_4, col_cop__cop with A'; Col; Cop.
        apply coplanar_perm_4, col_cop__cop with B'; Col; Cop.
    assert(Par A' C' A' C'').
      apply (par_trans _ _ A C).
        left.
        Par.
      Par.
    induction H15.
      apply H15.
      exists A'.
      split; Col.
    spliter.
    assert(~ Col A' B' C').
      intro.
      apply H.
      apply(col_par_par_col A' B' C' A B C H19); left; Par.
    assert( C' = C'').
      apply(l6_21 A' C' B' C'); Col.
      intro.
      subst C'.
      apply H19.
      Col.
    subst C''.
    Col.
Qed.

Lemma l13_18_3 : forall A B C A' B' C', ~Col A B C
                               -> Par_strict A B A' B'
                               -> Par_strict A C A' C'
                               -> (Par_strict B C B' C' /\ Par A A' B B')
                               -> (Par C C' A A' /\ Par C C' B B').
Proof.
    intros.
    spliter.
    assert(Par C C' A A').
      apply par_distincts in H3.
      spliter.
      assert(HH:= parallel_existence1 B B' C H5).
      ex_and HH P.
      induction(par_dec C P B C).
        induction H7.
          apply False_ind.
          apply H7.
          exists C.
          split; Col.
        spliter.
        assert(Col P B' C).
          induction H6.
            apply False_ind.
            apply H6.
            exists B.
            split; Col.
          spliter.
          Col.
        assert(Col C B B').
          apply (col_transitivity_1 _ P); Col.
        apply False_ind.
        apply H2.
        exists B'.
        split; Col.
      assert(~ Par C P B' C').
        intro.
        apply H7.
        apply(par_trans _ _ B' C'); Par.
      assert(Coplanar C P B' C').
        apply coplanar_perm_2, coplanar_trans_1 with B; [|Cop..].
        apply not_col_permutation_1, par_not_col with B' C'; Par; Col.
      assert(HH:=cop_npar__inter_exists C P B' C' H9 H8).
      ex_and HH C''.
      induction(eq_dec_points B' C'').
        subst C''.
        apply False_ind.
        induction H6.
          apply H6.
          exists B'.
          split; Col.
        spliter; apply H2.
        exists B'.
        split; Col.
        apply col_permutation_1.
        apply(col_transitivity_1 _ P); Col.
      assert(Par C C'' B B' ).
        apply (par_col_par_2 _ P); Col.
          intro.
          subst C''.
          apply H2.
          exists C.
          split; Col.
        Par.
      assert(Par B' C'' B C).
        apply (par_col_par_2 _ C'); Col.
        left.
        Par.
      assert(~ Col A' B' C').
        intro.
        apply H.
        assert(Par C' A' B C).
          apply (par_col_par_2 _ B').
            apply par_strict_distinct in H1.
            spliter.
            auto.
            Col.
          apply par_left_comm.
          left.
          Par.
        assert(Par B C A C).
          apply (par_trans _ _ A' C'); Par.
        induction H17.
          apply False_ind.
          apply H17.
          exists C.
          split; Col.
        spliter; Col.
      assert(Par A C A' C'').
        apply(l13_15_par B A C B' A' C'').
          intro.
          apply H.
          Col.
          apply par_strict_comm.
          Par.
          induction H14.
            Par.
          spliter.
          apply False_ind.
          apply H2.
          exists B'.
          split; Col.
          Par.
        Par.
      assert(C' = C'').
        apply (l6_21 C' A' B' C'); Col.
          intro.
          subst C'.
          apply H15.
          Col.
          eapply (col_par_par_col A C A); Col.
            apply par_right_comm.
            left.
            Par.
          Par.
      subst C''.
      apply (par_trans _ _ B B'); Par.
    split.
      Par.
    apply (par_trans _ _ A A'); Par.
Qed.

Lemma l13_18 :  forall A B C A' B' C' O, ~Col A B C /\ Par_strict A B A' B' /\  Par_strict A C A' C'
                                        ->(Par_strict B C B' C' /\ Col O A A' /\ Col O B B' -> Col O C C')
                                          /\ ((Par_strict B C B' C' /\ Par A A' B B') -> (Par C C' A A' /\ Par C C' B B'))
                                          /\ (Par A A' B B' /\ Par A A' C C' -> Par B C B' C').
Proof.
    intros.
    spliter.
    split.
      intros.
      apply (l13_18_2 A B C A' B' C' O); auto.
    split.
      intros.
      spliter.
      apply l13_18_3; auto.
    intros.
    spliter.
    apply (l13_15_par A B C A' B' C'); auto.
Qed.

Lemma l13_19_aux : forall A B C D A' B' C' D' O, ~Col O A B -> A <> A' -> A <> C
                                          -> O <> A -> O <> A' -> O <> C -> O <> C'
                                          -> O <> B -> O <> B' -> O <> D -> O <> D'
                                          -> Col O A C -> Col O A A' -> Col O A C'
                                          -> Col O B D -> Col O B B' -> Col O B D'
                                          -> ~Par A B C D
                                          -> Par A B A' B' -> Par A D A' D' -> Par B C B' C'
                                          -> Par C D C' D'.
Proof.
    intros.
    assert(Coplanar A B C D) by (exists O; right; left; split; Col).
    assert(HH:= cop_npar__inter_exists A B C D H20 H16).
    ex_and HH E.
    assert(~Par A' B' O E).
      intro.
      assert(Par A B O E).
        apply (par_trans _ _ A' B'); Par.
      induction H24.
        apply H24.
        exists E.
        split; Col.
      spliter.
      apply H.
      apply (col_transitivity_1 _ E); Col.
    assert(Coplanar A' B' O E).
      apply coplanar_pseudo_trans with O A B; Cop.
    assert(HH:= cop_npar__inter_exists A' B' O E H24 H23).
    ex_and HH E'.
    assert(C <> E).
      intro.
      subst E.
      apply H.
      apply col_permutation_2.
      apply (col_transitivity_1 _ C); Col.
    induction(col_dec A D E).
      assert(B = D).
        apply(l6_21 O B A E); Col.
        intro.
        subst E.
        apply H.
        assert(Col A O D).
          apply (col_transitivity_1 _ C); Col.
        apply (col_transitivity_1 _ D); Col.
      subst D.
      assert(Par A' B' A' D').
        apply (par_trans _ _ A B); Par.
      induction H29.
        apply False_ind.
        apply H29.
        exists A'.
        split; Col.
      spliter.
      assert(B' = D').
        eapply(l6_21 A' B' O B'); Col.
        intro.
        apply H.
        apply (col_transitivity_1 _ A'); Col.
        apply (col_transitivity_1 _ B'); Col.
        apply (col_transitivity_1 _ B); Col.
      subst D'.
      Par.
    assert(B <> B').
      intro.
      subst B'.
      induction H17.
        apply H17.
        exists B.
        split; Col.
      spliter.
      apply H.
      apply col_permutation_2.
      apply (col_transitivity_1 _ A'); Col.
    assert(Par D E D' E').
      apply (l13_15 A _ _ A' _ _ O); Col.
        exists B; left; split; Col.
        induction H18.
          auto.
        spliter.
        apply False_ind.
        assert(Col A' A D).
          apply (col_transitivity_1 _ D'); Col.
        assert(Col A O D).
          apply (col_transitivity_1 _ A'); Col.
        apply H.
        apply (col_transitivity_1 _ D); Col.
        assert(Par A E A' E').
          apply(par_col_par_2 _ B); Col.
            intro.
            subst E.
            apply H28.
            Col.
          apply par_symmetry.
          apply(par_col_par_2 _ B'); Col.
            intro.
            subst E'.
            assert(Col O A E).
              apply(col_transitivity_1 _ A'); Col.
            apply H.
            apply col_permutation_2.
            apply(col_transitivity_1 _ E); Col.
            intro.
            subst E.
            apply H28.
            Col.
          Par.
        induction H30.
          auto.
        spliter.
        apply False_ind.
        assert(Col A' A E).
          apply(col_transitivity_1 _ E'); Col.
        assert(Col A O E).
          apply(col_transitivity_1 _ A'); Col.
        apply H.
        apply col_permutation_2.
        apply(col_transitivity_1 _ E); Col.
      apply(col_transitivity_1 _ B); Col.
    apply par_comm.
    induction(col_dec B C E).
      assert(B = D).
        apply(l6_21 O B C E); Col.
        intro.
        apply H.
        apply (col_transitivity_1 _ C); Col.
      subst D.
      assert(Par A' B' A' D').
        apply (par_trans _ _ A B); Par.
      induction H32.
        apply False_ind.
        apply H32.
        exists A'.
        split; Col.
      spliter.
      assert(B' = D').
        eapply(l6_21 A' B' O B'); Col.
          Col5.
        ColR.
      subst D'.
      Par.
    assert(Par C E C' E').
      apply (l13_15 B _ _ B' _ _ O); Col.
        exists D; right; left; split; Col.
        induction H19.
          auto.
        spliter.
        apply False_ind.
        apply H.
        assert(Col B O C').
          apply (col_transitivity_1 _ B'); Col.
        apply (col_transitivity_1 _ C'); Col.
        assert(Par B E B' E').
          apply (par_col_par_2 _ A); Col.
            intro.
            subst E.
            apply H31.
            Col.
          apply par_symmetry.
          apply (par_col_par_2 _ A'); Col.
            intro.
            subst E'.
            assert(Col O B E).
              apply (col_transitivity_1 _ B'); Col.
            apply H.
            apply col_permutation_1.
            apply (col_transitivity_1 _ E); Col.
            intro.
            subst E.
            apply H31.
            Col.
          Par.
        induction H32.
          auto.
        spliter.
        apply False_ind.
        apply H.
        assert(Col O B' E').
          apply col_permutation_2.
          apply (col_transitivity_1 _ B); Col.
        assert(Col B' A' O).
          apply (col_transitivity_1 _ E'); Col.
        apply (col_transitivity_1 _ A'); Col.
        apply (col_transitivity_1 _ B'); Col.
      apply (col_transitivity_1 _ A); Col.
    apply(par_col_par_2 _ E); Col.
      intro.
      subst D.
      apply H.
      apply(col_transitivity_1 _ C); Col.
    apply par_symmetry.
    apply(par_col_par_2 _ E'); Col.
      intro.
      subst D'.
      apply H.
      apply(col_transitivity_1 _ C'); Col.
      apply (col_par_par_col D E C); Par.
      Col.
    Par.
Qed.

Lemma l13_19 : forall A B C D A' B' C' D' O, ~Col O A B
                                          -> O <> A -> O <> A' -> O <> C -> O <> C'
                                          -> O <> B -> O <> B' -> O <> D -> O <> D'
                                          -> Col O A C -> Col O A A' -> Col O A C'
                                          -> Col O B D -> Col O B B' -> Col O B D'
                                          -> Par A B A' B' -> Par A D A' D' -> Par B C B' C'
                                          -> Par C D C' D'.
Proof.
    intros.
    induction (eq_dec_points A A').
      subst A'.
      assert(B = B').
        apply(l6_21 A B O B); Col.
        induction H14.
          apply False_ind.
          apply H14.
          exists A.
          split; Col.
        spliter.
        Col.
      subst B'.
      assert(D = D').
        apply(l6_21 A D O B); Col.
          intro.
          apply H.
          apply (col_transitivity_1 _ D); Col.
          induction H15.
            apply False_ind.
            apply H15.
            exists A.
            split; Col.
          spliter.
          Col.
      subst D'.
      assert(C = C').
        apply(l6_21 B C O A); Col.
          intro.
          apply H.
          apply (col_transitivity_1 _ C); Col.
          induction H16.
            apply False_ind.
            apply H16.
            exists B.
            split; Col.
          spliter.
          Col.
      subst C'.
      apply par_reflexivity.
      intro.
      subst D.
      apply H.
      apply (col_transitivity_1 _ C); Col.
    induction(eq_dec_points A C).
      subst C.
      assert(A' = C').
        assert(Par A' B' B' C').
          apply (par_trans _ _ A B); Par.
        induction H18.
          apply False_ind.
          apply H18.
          exists B'.
          split; Col.
        spliter.
        eapply (l6_21 B' C' O A); Col.
        intro.
        apply H.
        apply (col_transitivity_1 _ B'); Col.
        apply (col_transitivity_1 _ C'); Col.
      subst C'.
      auto.
    induction(eq_dec_points A' C').
      subst C'.
      assert(A = C).
        assert(Par A B B C).
          apply (par_trans _ _ A' B'); Par.
        induction H19.
          apply False_ind.
          apply H19.
          exists B.
          split; Col.
        spliter.
        eapply (l6_21 B C O A'); Col.
          intro.
          apply H.
          apply (col_transitivity_1 _ C); Col.
          apply (col_transitivity_1 _ A); Col.
      contradiction.
    induction(par_dec C D C' D').
      auto.
    assert(HH:=not_par_one_not_par C D C' D' A' B' H20).
    induction HH.
      assert(~ Par C D A B).
        intro.
        apply H21.
        apply (par_trans _ _ A B); Par.
      (*assert(HH:= not_par_inter C D C' D' A B H19).
      ex_and HH E.
      induction H21.*)
      apply (l13_19_aux A B C D A' B' C' D' O); Col.
      intro.
      apply H21.
      apply (par_trans _ _ A B); Par.
    apply par_symmetry.
    apply (l13_19_aux A' B' C' D' A B C D O); Par.
      intro.
      apply H.
      apply (col_transitivity_1 _ A'); Col.
      apply (col_transitivity_1 _ B'); Col.
      apply (col_transitivity_1 _ A); Col.
      Col.
      apply (col_transitivity_1 _ A); Col.
      apply (col_transitivity_1 _ B); Col.
      Col.
    apply (col_transitivity_1 _ B); Col.
Qed.

Lemma l13_19_par_aux : forall A B C D A' B' C' D' X Y,
                                             X <> A -> X <> A' -> X <> C -> X <> C'
                                          -> Y <> B -> Y <> B' -> Y <> D -> Y <> D'
                                          -> Col X A C -> Col X A A' -> Col X A C'
                                          -> Col Y B D -> Col Y B B' -> Col Y B D'
                                          -> A <> C -> B <> D -> A <> A'
                                          -> Par_strict X A Y B
                                          -> ~Par A B C D
                                          -> Par A B A' B' -> Par A D A' D' -> Par B C B' C'
                                          -> Par C D C' D'.
Proof.
    intros.
    assert(Coplanar A B C D).
      apply coplanar_perm_2, col_cop__cop with Y; Col.
      apply coplanar_perm_16, col_cop__cop with X; Col; Cop.
    assert(HH := cop_npar__inter_exists A B C D H21 H17).
    ex_and HH E.
    assert(HH:= parallel_existence1 X A E H).
    ex_and HH Z.
    assert(~Par A B E Z).
      intro.
      assert(Par Y B E Z).
        apply (par_trans _ _ X A); Par.
      induction H25.
        apply H25.
        exists E.
        split; Col.
      spliter.
      induction H24.
        apply H24.
        exists A.
        split; Col.
      spliter.
      induction H26.
        apply H26.
        exists B.
        split; Col.
      spliter.
      apply H16.
      exists E.
      split;ColR.
    assert(~Par A' B' E Z).
      intro.
      apply H25.
      apply (par_trans _ _ A' B'); Par.
    assert(Coplanar A' B' E Z).
      induction H24.
        CopR.
      spliter.
      exfalso.
      apply H25.
      right.
      assert_diffs.
      repeat split; auto.
      assert (A <> E).
        intro.
        subst E.
        apply H16.
        exists D; split; ColR.
      ColR.
    assert(HH:= cop_npar__inter_exists A' B' E Z H27 H26).
    ex_and HH E'.
    assert(~Col A D E).
      intro.
      induction (eq_dec_points A E).
        subst E.
        apply H13.
        apply (l6_21 X A D A); Col.
          intro.
          apply H16.
          exists D.
          split; Col.
        apply par_distincts in H19.
        spliter.
        auto.
      assert(Col A B D) by ColR.
      apply H16.
      exists A.
      split; Col.
      ColR.
    assert(Par_strict X A E Z).
      induction H24.
        Par.
      spliter.
      apply False_ind.
      assert(Col E X A) by ColR.
      assert(Col A C E) by ColR.
      apply H13.
      apply (l6_21 A E D C); Col.
        intro.
        subst D.
        contradiction.
        apply col_permutation_2.
        apply (col_transitivity_1  _ E); Col.
        intro.
        subst E.
        clean_trivial_hyps.
        apply H16.
        exists B.
        split; Col.
        apply col_permutation_1.
        apply (col_transitivity_1  _ C); Col.
    assert(Par Y B E Z).
      apply (par_trans _ _ X A); Par.
    assert(Par_strict Y B E Z).
      induction H32.
        Par.
      spliter.
      apply False_ind.
      assert(Col E Y B) by ColR.
      assert(Col B D E) by ColR.
      apply H14.
      apply (l6_21 B E C D); Col.
        intro.
        apply H16.
        exists C.
        split; Col.
        apply col_permutation_1.
        apply (col_transitivity_1  _ E); Col.
        intro.
        subst E.
        apply H16.
        exists C.
        split; Col.
        clean_trivial_hyps.
        apply col_permutation_1.
        apply (col_transitivity_1  _ D); Col.
      intro.
      subst D.
      apply H16.
      exists C.
      split; Col.
      ColR.
    assert(~Col A' D' E').
      intro.
      assert(Col A' B' D').
        apply (col_transitivity_1  _ E'); Col.
        intro.
        subst E'.
        apply H31.
        exists A'.
        split; Col.
      apply H16.
      exists A'.
      split; Col.
      assert(Col Y B' D').
        apply (col_transitivity_1  _ B); Col.
      assert(Col B' A' Y).
        apply (col_transitivity_1  _ D'); Col.
        intro.
        subst D'.
        assert(Par A D A B).
          apply(par_trans _ _ A' B'); Par.
        induction H37.
          apply H37.
          exists A.
          split; Col.
        spliter.
        apply H16.
        exists A.
        split; Col.
        apply col_permutation_1.
        apply (col_transitivity_1  _ D); Col.
      apply col_permutation_2.
      apply (col_transitivity_1  _ B'); Col.
    assert(~ Col X A B).
      intro.
      apply H16.
      exists B.
      split; Col.
    assert(~ Col Y A B).
      intro.
      apply H16.
      exists A.
      split; Col.
    assert(B <> B').
      intro.
      subst B'.
      apply H15.
      apply(l6_21 X A B A); Col.
        intro.
        subst B.
        apply H35.
        Col.
        induction H18.
          apply False_ind.
          apply H18.
          exists B.
          split; Col.
        spliter.
        Col.
    assert(C <> C').
      intro.
      subst C'.
      induction H20.
        apply H20.
        exists C.
        split; Col.
      spliter.
      apply H16.
      exists C.
      split; Col.
      apply col_permutation_1.
      apply (col_transitivity_1  _ B'); Col.
    assert(D <> D').
      intro.
      subst D'.
      induction H19.
        apply H19.
        exists D.
        split; Col.
      spliter.
      apply H16.
      exists D.
      split; Col.
      apply col_permutation_1.
      apply (col_transitivity_1  _ A'); Col.
    assert(A' <> C').
      intro.
      subst C'.
      assert(Par B C A B).
        apply (par_trans _ _ A' B'); Par.
      induction H40.
        apply H40.
        exists B.
        split; Col.
      spliter.
      apply H16.
      exists B.
      split; ColR.
    assert(B' <> D').
      intro.
      subst D'.
      assert(Par A D A B).
        apply (par_trans _ _ A' B'); Par.
      induction H41.
        apply H41.
        exists A.
        split; Col.
      spliter.
      apply H16.
      exists A.
      split; Col.
      apply col_permutation_1.
      apply (col_transitivity_1  _ D); Col.
    assert(A <> E).
      intro.
      subst E.
      apply H30.
      Col.
    assert(A' <> E').
      intro.
      subst E'.
      apply H34.
      Col.
    assert(B <> E).
      intro.
      subst E.
      apply H33.
      exists B.
      split; Col.
    assert(B' <> E').
      intro.
      subst E'.
      apply H33.
      exists B'.
      split; Col.
    (*-------------------*)
    assert(Par A E A' E').
      apply (par_col_par_2 _ B); Col.
      apply par_symmetry.
      apply (par_col_par_2 _ B'); Col.
      Par.
    assert(Par_strict A E A' E').
      induction H46.
        Par.
      spliter.
      apply False_ind.
      apply H47.
      apply (l6_21 X A' B' E'); Col.
        intro.
        apply H16.
        exists B'.
        split; Col.
        apply col_permutation_2.
        apply (col_transitivity_1  _ A'); Col.
      apply col_permutation_2.
      apply (col_transitivity_1  _ A); Col.
    assert(Par D E D' E').
      apply(l13_15_par A D E A' D' E'); Par.
        induction H19.
          Par.
        spliter.
        apply False_ind.
        apply H16.
        exists D.
        split; Col.
        apply col_permutation_1.
        apply (col_transitivity_1  _ A'); Col.
        apply col_permutation_2.
        apply (col_transitivity_1  _ D'); Col.
        apply (par_col_par_2 _ X); Col.
        apply par_symmetry.
        apply (par_col_par_2 _ Y); Col.
          apply col_permutation_2.
          apply (col_transitivity_1  _ B); Col.
        apply par_comm.
        apply (par_col_par_2 _ B); Col.
        apply (par_trans _ _ E Z); Par.
      apply (par_col_par_2 _ X); Par; Col.
      apply par_symmetry.
      apply (par_col_par_2 _ Z); Col.
        intro.
        subst E'.
        apply H47.
        exists E.
        split; Col.
      Par.
    assert(Par C E C' E').
      eapply(l13_15_par B C E B' C' E'); Par.
        intro.
        assert(Col B A C) by ColR.
        apply H16.
        exists B.
        split; ColR.
        induction H20.
          Par.
        spliter.
        apply False_ind.
        apply H16.
        exists B'.
        split; Col.
        assert(Col X C C').
          apply (col_transitivity_1  _ A); Col.
        assert(Col C B' X).
          apply (col_transitivity_1  _ C'); Col.
        apply col_permutation_2.
        apply (col_transitivity_1  _ C); Col.
        assert(Par B E B' E').
          apply (par_col_par_2 _ A); Col.
          apply par_symmetry.
          apply (par_col_par_2 _ A'); Col.
          Par.
        induction H49.
          Par.
        spliter.
        apply False_ind.
        assert(Col B' A' B) by ColR.
        apply H16.
        exists A'.
        split; ColR.
        apply (par_col_par_2 _ Y); Col.
        apply par_symmetry.
        apply (par_col_par_2 _ X); Col.
          apply col_permutation_2.
          apply (col_transitivity_1  _ A); Col.
        apply par_left_comm.
        apply (par_col_par_2 _ A); Col.
        apply (par_trans _ _ E Z); Par.
      apply (par_col_par_2 _ Y); Col.
      apply par_symmetry.
      apply (par_col_par_2 _ Z); Col.
        intro.
        subst E'.
        apply H47.
        exists E.
        split; Col.
      Par.
    apply (par_col_par_2 _ E); Col.
      intro.
      subst D.
      apply H16.
      exists C.
      split; Col.
    apply par_symmetry.
    apply (par_col_par_2 _ E'); Col.
      intro.
      subst D'.
      apply H16.
      exists C'.
      split; Col.
      apply (col_par_par_col C E D); Col ; Par.
    Par.
Qed.

Lemma l13_19_par : forall A B C D A' B' C' D' X Y,
 X <> A -> X <> A' -> X <> C -> X <> C'-> Y <> B -> Y <> B' -> Y <> D -> Y <> D' ->
 Col X A C -> Col X A A' -> Col X A C' -> Col Y B D -> Col Y B B' -> Col Y B D' ->
 Par_strict X A Y B -> Par A B A' B' -> Par A D A' D' -> Par B C B' C' ->
 Par C D C' D'.
Proof.
    intros.
    induction(eq_dec_points A C).
      subst C.
      assert(Par A' B' B' C').
        apply(par_trans _ _ A B); Par.
      induction H17.
        apply False_ind.
        apply H17.
        exists B'.
        split; Col.
      spliter.
      assert(A' = C').
        apply (l6_21 X A B' A'); Col.
        intro.
        apply H13.
        exists B'.
        split; Col.
      subst C'.
      Par.
    induction(eq_dec_points B D).
      subst D.
      assert(Par A' B' A' D').
        apply(par_trans _ _ A B); Par.
      induction H18.
        apply False_ind.
        apply H18.
        exists A'.
        split; Col.
      spliter.
      assert(B' = D').
        apply (l6_21 Y B A' B'); Col.
        intro.
        apply H13.
        exists A'.
        split; Col.
      subst D'.
      Par.
    induction(eq_dec_points A A').
      subst A'.
      induction H14.
        apply False_ind.
        apply H14.
        exists A.
        split; Col.
      spliter.
      assert(B = B').
        apply (l6_21 Y B A B); Col.
        intro.
        apply H13.
        exists A.
        split; Col.
      subst B'.
      assert(C = C').
        induction H16.
          apply False_ind.
          apply H16.
          exists B.
          split; Col.
        spliter.
        apply (l6_21 X A B C); Col.
        intro.
        apply H13.
        exists B.
        split; Col.
      subst C'.
      assert(D = D').
        induction H15.
          apply False_ind.
          apply H15.
          exists A.
          split; Col.
        spliter.
        apply (l6_21 Y B A D); Col.
        intro.
        apply H13.
        exists A.
        split; Col.
      subst D'.
      auto.
      apply par_reflexivity.
      intro.
      subst D.
      clean_trivial_hyps.
      apply H13.
      exists C.
      split; Col.
    induction(par_dec C D C' D').
      auto.
    assert(HH:=not_par_one_not_par C D C' D' A B H20).
    induction HH.
      eapply (l13_19_par_aux A B C D A' B' C' D' X Y); Col.
      intro.
      apply H21.
      Par.
    apply par_distincts in H14.
    spliter.
    apply par_symmetry.
    eapply (l13_19_par_aux A' B' C' D' A B C D X Y); sfinish.
      intro.
      subst C'.
      apply H17.
      apply (l6_21 X A B A); Col.
        intro.
        apply H13.
        exists B.
        split; Col.
        assert(Par B C B A).
          apply(par_trans _ _ A' B'); Par.
        induction H24.
          apply False_ind.
          apply H24.
          exists B.
          split; Col.
        spliter.
        Col.
      intro.
      apply H18.
      subst D'.
      assert(Par A D A B).
        apply(par_trans _ _ A' B'); Par.
      apply (l6_21 Y B A B); Col.
        intro.
        apply H13.
        exists A.
        split; Col.
        induction H24.
          apply False_ind.
          apply H24.
          exists A.
          split; Col.
        spliter.
        Col.
      unfold Par_strict in H13.
      spliter.
      unfold Par_strict.
      split.
        apply coplanar_perm_16, col_cop__cop with A; Col.
        apply coplanar_perm_16, col_cop__cop with B; Col.
      intro.
      apply H24.
      ex_and H25 P.
      exists P.
      split.
        ColR.
      ColR.
    intro.
    apply H21.
    apply (par_trans _ _ A' B'); Par.
Qed.

End Desargues_Hessenberg.


(** Associativity lists. *)
Require Import Coq.Lists.List.

Import ListNotations.

Fixpoint add {A B} (eqb : A -> A -> bool) (l : list (A * B)) (k : A) (v : B)
  : list (A * B) :=
  match l with
  | [] => [(k, v)]
  | (k', v') :: l =>
    if eqb k k' then
      (k, v) :: l
    else
      (k', v') :: add eqb l k v
  end.

Fixpoint find {A B} (eqb : A -> A -> bool) (l : list (A * B)) (k : A)
  : option B :=
  match l with
  | [] => None
  | (k', v) :: l =>
    if eqb k k' then
      Some v
    else
      find eqb l k
  end.

Fixpoint remove {A B} (eqb : A -> A -> bool) (l : list (A * B)) (k : A)
  : list (A * B) :=
  match l with
  | [] => l
  | (k', v) :: l =>
    if eqb k k' then
      l
    else
      (k', v) :: remove eqb l k
  end.

Module Test.
  Require Import Coq.Arith.EqNat.

  Definition add_nil {A B} (eqb : A -> A -> bool) (k : A) (v : B)
    : add eqb [] k v = [(k, v)] :=
    eq_refl.

  Definition add_nat_1
    : add beq_nat [(2, 4); (3, 6)] 3 7 = [(2, 4); (3, 7)] :=
    eq_refl.

  Definition add_nat_2
    : add beq_nat [(2, 4); (3, 6)] 4 7 = [(2, 4); (3, 6); (4, 7)] :=
    eq_refl.

  Definition find_nil {A B} (eqb : A -> A -> bool) (k : A)
    : find (B := B) eqb [] k = None :=
    eq_refl.

  Definition find_nat_1 : find beq_nat [(2, 4); (3, 6)] 3 = Some 6 :=
    eq_refl.

  Definition find_nat_2 : find beq_nat [(2, 4); (3, 6)] 4 = None :=
    eq_refl.

  Definition remove_nil {A B} (eqb : A -> A -> bool) (k : A)
    : remove (B := B) eqb [] k = [] :=
    eq_refl.

  Definition remove_nat_1
    : remove beq_nat [(2, 4); (3, 6)] 3 = [(2, 4)] :=
    eq_refl.

  Definition remove_nat_2
    : remove beq_nat [(2, 4); (3, 6)] 4 = [(2, 4); (3, 6)] :=
    eq_refl.
End Test.