Require Import XR_Rmin.
Require Import XR_Rlt.
Require Import XR_Rle_dec.

Local Open Scope R_scope.

Lemma Rmin_Rgt_r : forall r1 r2 r, r < r1  /\ r < r2 -> r < Rmin r1 r2 .
Proof.
  intros x y z.
  intros [ hzx hzy ].
  unfold Rmin.
  destruct (Rle_dec x y) as [ hminl | hminr ].
  { exact hzx. }
  { exact hzy. }
Qed.


(* A theory of limits of a sequence *)

Set Implicit Arguments.

Require Import Arith.
Require Import Fold.
Require Import List.

Require Import StdNat.
Require Import Rat.

Section Limit.

  Variable A : Set.
  Variable eq : A -> A -> Prop.
  Hypothesis eq_dec : forall (a1 a2 : A),
    {eq a1 a2} + {~eq a1 a2}.
  Hypothesis eq_refl : forall (a : A),
    eq a a.
  Hypothesis eq_symm : forall a1 a2,
    eq a1 a2 ->
    eq a2 a1.

  Variable distance : A -> A -> A.
  Hypothesis distance_comm : forall a1 a2,
    eq (distance a1 a2) (distance a2 a1).
  Variable half : A -> A.
  Variable zero : A.
  Hypothesis half_nz : forall (a : A),
    ~eq a zero ->
    ~eq (half a) zero.

  Hypothesis distance_eq_zero : forall (a1 a2 : A),
    eq a1 a2 <->
    eq (distance a1 a2) zero.
  Hypothesis distance_eq_compat : forall a1 a2 a3 a4,
    eq a1 a3 ->
    eq a2 a4 ->
    eq (distance a1 a2) (distance a3 a4).

  Variable le : A -> A -> Prop.
  Hypothesis le_eq : forall (a1 a2 : A),
    eq a1 a2 ->
    le a1 a2.
  Hypothesis le_trans : forall (a1 a2 a3 : A),
    le a1 a2 ->
    le a2 a3 ->
    le a1 a3.

  (* all numbers positive *)
  Hypothesis all_pos : forall (a : A),
    le zero a.
  Hypothesis le_impl_eq : forall (a1 a2 : A),
    le a1 a2 ->
    le a2 a1 ->
    eq a1 a2.

  Variable plus : A -> A -> A.
  Variable plus_0_eq : forall (a1 a2 : A),
    eq a2 zero ->
    eq a1 (plus a1 a2).
  Variable plus_le_compat : forall a1 a2 a3 a4,
    le a1 a2 ->
    le a3 a4 ->
    le (plus a1 a3) (plus a2 a4).

  Hypothesis triangle_inequality : forall (a1 a2 a3 : A),
    le (distance a1 a2) (plus (distance a1 a3) (distance a3 a2)).
  Hypothesis half_plus : forall (a : A),
    eq (plus (half a) (half a)) a.
  Hypothesis le_half : forall (a : A),
    le a (half a) ->
    eq a zero.

  Theorem le_epsilon_zero : forall (a : A),
    (forall (epsilon : A), ~eq epsilon zero -> le a epsilon) ->
    eq a zero.

    intuition.

    destruct (eq_dec a zero).
    trivial.

    exfalso.
    specialize (H (half a)).
    apply f.
    eapply le_half.
    apply H.
    eapply half_nz.
    trivial.
  Qed.

  Definition left_total(r : nat -> A -> Prop) :=
    forall n, exists a, r n a.

  Definition functional(r : nat -> A -> Prop) :=
    forall n a1 a2,
      r n a1 ->
      r n a2 ->
      eq a1 a2.

  Definition inf_limit(f : nat -> A -> Prop)(a : A) :=
    forall (epsilon : A),
      ~eq epsilon zero ->
      exists n : nat,
        forall (n' : nat),
          n' >= n ->
          forall a',
            f n' a' ->
            le (distance a' a) epsilon.

    (* Note: if the codomain of the relation is empty (after any point), then we can assign any limit to it. *)

  (* We could define inf_limit in terms of inf_limit_2, but inf_limit_2 only shows up in proofs, while inf_limit shows up in top-level definitions. *)
  Definition inf_limit_2(f f' : nat -> A -> Prop) :=
    forall (epsilon : A),
      ~eq epsilon zero ->
      exists n : nat,
        forall (n' : nat),
          n' >= n ->
          forall a a',
            f n' a ->
            f' n' a' ->
            le (distance a a') epsilon.

  Theorem inf_limit_2_const : forall (f : nat -> A -> Prop)(a : A),
    inf_limit_2 f (fun x => eq a) <->
    inf_limit f a.

    intuition.
  Abort.

(*  limits are unique for left-total relations *)
  Theorem limit_eq_h : forall f epsilon a1 a2,
    left_total f ->
    ~eq epsilon zero ->
    inf_limit f a1 ->
    inf_limit f a2 ->
    le (distance a1 a2) epsilon.

   (*  remember half as h. *)

    intuition.
    unfold inf_limit in *.
    intuition.
    specialize (H1 (half epsilon)).
    specialize (H2 (half epsilon)).

    destruct H1.
    intuition.
    eapply half_nz; eauto.

    destruct H2.
    intuition.
    eapply half_nz; eauto.

    destruct (H (max x x0)).
    specialize (H1 (max x x0)).
    specialize (H2 (max x x0)).

    eapply le_trans.
    eapply (triangle_inequality _ _ x1).
    eapply le_trans.
    eapply plus_le_compat.
    eapply le_trans.
    eapply le_eq.
    eapply distance_comm.
    eapply H1.
    eapply Max.max_lub_l; eauto.
    trivial.
    eapply H2.
    eapply Max.max_lub_r; eauto.
    trivial.
    eapply le_eq.
    eapply half_plus.
  Qed.

  Theorem limits_eq : forall f a1 a2,
    left_total f ->
    inf_limit f a1 ->
    inf_limit f a2 ->
    eq a1 a2.

    intuition.
    eapply distance_eq_zero.

    eapply le_epsilon_zero.
    intuition.

    eapply limit_eq_h; eauto.
  Qed.

  Theorem limit_f_eq : forall f1 f2 a,
    inf_limit f1 a ->
    (forall n a', (f1 n a' <-> f2 n a')) ->
    inf_limit f2 a.

    unfold inf_limit; intuition.

    destruct (H epsilon).
    trivial.
    exists x.
    intuition.
    eapply H2.
    eapply H3.
    eapply H0.
    trivial.
  Qed.

End Limit.

(* limits for Rat *)
Local Open Scope rat_scope.

Definition rat_inf_limit(f : nat -> Rat -> Prop)(r : Rat) :=
  inf_limit eqRat ratDistance rat0 leRat f r.

Definition rat_inf_limit_2(f1 f2 : nat -> Rat -> Prop) :=
  inf_limit_2 eqRat ratDistance rat0 leRat f1 f2.

Definition rat_limits_eq :=
  limits_eq eq_Rat_dec ratDistance_comm ratHalf ratHalf_ne_0 ratIdentityIndiscernables eqRat_impl_leRat leRat_trans ratAdd ratAdd_leRat_compat ratTriangleInequality ratHalf_add le_ratHalf_0.

Require Import Arith.

Theorem rat_inf_limit_2_trans : forall f1 f2 f3,
  rat_inf_limit_2 f1 f2 ->
  rat_inf_limit_2 f2 f3 ->
  left_total f2 ->
  rat_inf_limit_2 f1 f3.

  unfold rat_inf_limit_2, inf_limit_2; intuition.
  edestruct (H (ratHalf epsilon)).
  eapply ratHalf_ne_0; intuition.
  edestruct (H0 (ratHalf epsilon)); eauto.
  eapply ratHalf_ne_0.
  intuition.
  exists (max x x0).
  intuition.
  destruct (H1 n').
  eapply leRat_trans.
  eapply ratDistance_le_trans.
  eapply H3.
  eapply Max.max_lub_l.
  eapply H5.
  trivial.
  eapply H8.
  eapply H4.
  eapply Max.max_lub_r.
  eapply H5.
  eauto.
  trivial.
  eapply eqRat_impl_leRat.
  eapply ratHalf_add.
Qed.

Lemma rat_inf_limit_squeeze : forall (f1 f2 f: nat -> Rat -> Prop) c (v : Rat),
  rat_inf_limit f1 v ->
  rat_inf_limit f2 v ->
  (forall n a a1, n >= c -> f n a -> f1 n a1 -> a1 <= a) ->
  (forall n a a2, n >= c -> f n a -> f2 n a2 -> a <= a2) ->
  left_total f1 ->
  left_total f2 ->
  rat_inf_limit f v.

  unfold rat_inf_limit, inf_limit in *.
  intuition.
  destruct (H epsilon); intuition.
  destruct (H0 epsilon); intuition.
  exists (max c (max x x0)).
  intuition.

  destruct (H3 n').
  destruct (H4 n').
  eapply leRat_trans.
  eapply ratDistance_le_max.
  eapply H1.
  eapply Max.max_lub_l.
  eauto.
  eapply H9.
  eapply H10.

  eapply H2.
  eapply Max.max_lub_l.
  eauto.
  eapply H9.
  eapply H11.

  eapply maxRat_leRat_same; eauto using Max.max_lub_l, Max.max_lub_r.

Qed.

Lemma rat_inf_limit_div_2 : forall (f : nat -> Rat -> Prop)(v : Rat),
  rat_inf_limit f v ->
  rat_inf_limit (fun n => (f (div2 n))) v.

  unfold rat_inf_limit, inf_limit.
  intuition.
  destruct (H epsilon); intuition.

  econstructor.
  intuition.
  specialize (H1 (div2 n')).
  eapply H1.

  eapply div2_ge; eauto.
  eauto.
Qed.

Lemma rat_inf_limit_sum : forall (f1 f2 : nat -> Rat -> Prop) v1 v2,
  left_total f1 ->
  left_total f2 ->
  rat_inf_limit f1 v1 ->
  rat_inf_limit f2 v2 ->
  rat_inf_limit (fun n => (ratAdd_rel (f1 n) (f2 n))) (v1 + v2).

  unfold rat_inf_limit, inf_limit in *.
  intuition.
  edestruct (H1 (ratHalf epsilon)).
  eapply ratHalf_ne_0.
  intuition.
  edestruct (H2 (ratHalf epsilon)).
  eapply ratHalf_ne_0.
  intuition.
  exists (Max.max x x0).
  intuition.
  unfold ratAdd_rel in *.
  destruct (H n').
  destruct (H0 n').
  rewrite H7; eauto.
  eapply leRat_trans.
  eapply rat_distance_of_sum.
  rewrite H4.
  rewrite H5.
  rewrite ratHalf_add.
  intuition.
  eapply Max.max_lub_r.
  eauto.
  trivial.
  eapply Max.max_lub_l.
  eauto.
  trivial.
Qed.

Lemma rat_inf_limit_difference : forall (f1 f2 : nat -> Rat -> Prop) c1 c2,
  left_total f1 ->
  left_total f2 ->
  rat_inf_limit f1 c1 ->
  rat_inf_limit f2 c2 ->
  rat_inf_limit (fun n => (ratSubtract_rel (f1 n) (f2 n))) (ratSubtract c1 c2).

  unfold rat_inf_limit, inf_limit in *.
  intuition.

  destruct (le_Rat_dec c1 c2).

  edestruct (H1 (ratHalf epsilon)).
  eapply ratHalf_ne_0.
  intuition.
  edestruct (H2 (ratHalf epsilon)).
  eapply ratHalf_ne_0.
  intuition.
  exists (Max.max x x0).
  intuition.
  unfold ratSubtract_rel in *.
  destruct (H n').
  destruct (H0 n').
  rewrite H7; eauto.
  rewrite (ratSubtract_0 l).
  eapply ratDistance_0_r_le.

  eapply leRat_trans.
  eapply ratSubtract_partition_leRat.

  eapply ratSubtract_ratDistance_le.
  Focus 2.
  rewrite H4.
  rewrite ratHalf_add.
  intuition.
  eapply Max.max_lub_l.
  eauto.
  trivial.
  eapply leRat_trans.
  eapply ratSubtract_partition_leRat.
  rewrite ratSubtract_0.
  eapply leRat_refl.
  eapply l.
  eapply ratSubtract_ratDistance_le.
  rewrite ratDistance_comm.
  rewrite H5.
  rewrite <- ratAdd_0_l.
  intuition.
  eapply Max.max_lub_r.
  eauto.
  trivial.

  edestruct (H1 (minRat (ratHalf epsilon) (ratHalf (ratSubtract c1 c2)))).
  intuition.
  unfold minRat in *.
  destruct (bleRat (ratHalf epsilon) (ratHalf (ratSubtract c1 c2))).
  eapply ratHalf_ne_0 in H4;
  intuition.
  eapply ratHalf_ne_0 in H4;
  intuition.
  eapply n.
  eapply ratSubtract_0_inv.
  trivial.

  edestruct (H2 (minRat (ratHalf epsilon) (ratHalf (ratSubtract c1 c2)))).
  intuition.
  unfold minRat in *.
  destruct (bleRat (ratHalf epsilon) (ratHalf (ratSubtract c1 c2))).
  eapply ratHalf_ne_0 in H5;
  intuition.
  eapply ratHalf_ne_0 in H5;
  intuition.
  eapply n.
  eapply ratSubtract_0_inv.
  trivial.

  exists (Max.max x x0).
  intuition.
  destruct (H n').
  destruct (H0 n').
  unfold ratSubtract_rel in *.
  rewrite H7; eauto.
  assert (x2 <= x1).
  eapply leRat_trans.
  eapply ratDistance_le_sum.
  eapply H5.
  eapply Max.max_lub_r.
  eauto.
  trivial.
  eapply leRat_trans.
  eapply ratAdd_leRat_compat.
  eapply leRat_refl.

  eapply minRat_le_r.
  eapply (leRat_ratAdd_same_r (ratHalf (ratSubtract c1 c2))).
  rewrite ratAdd_assoc.
  rewrite ratHalf_add.
  rewrite ratSubtract_ratAdd_inverse_2.
  eapply ratDistance_le_sum.
  eapply leRat_trans.
  rewrite ratDistance_comm.
  eapply H4.
  eapply Max.max_lub_l.
  eauto.
  trivial.
  eapply minRat_le_r.
  case_eq (bleRat c1 c2); intuition.
  eapply bleRat_total.
  trivial.

  eapply leRat_trans.
  eapply rat_distance_of_difference.
  trivial.
  case_eq (bleRat c1 c2); intuition.
  eapply bleRat_total.
  trivial.

  eapply H4.
  eapply Max.max_lub_l.
  eauto.
  trivial.

  eapply H5.
  eapply Max.max_lub_r.
  eauto.
  trivial.

  rewrite minRat_le_l.
  rewrite ratHalf_add.
  intuition.
Qed.

Lemma rat_inf_limit_product : forall (f1 f2 : nat -> Rat -> Prop) c1 c2,
  left_total f1 ->
  left_total f2 ->
  rat_inf_limit f1 c1 ->
  rat_inf_limit f2 c2 ->
  rat_inf_limit (fun n => (ratMult_rel (f1 n) (f2 n))) (c1 * c2).

  (* This is the proof found at http://planetmath.org/ProofOfLimitRuleOfProduct.html *)

  unfold rat_inf_limit, inf_limit in *.
  intuition.

  edestruct (H1 ((ratInverse (1 + c2)) * epsilon * (1/ 2))).
  intuition.
  apply ratMult_0 in H4.
  intuition.
  apply ratMult_0 in H5.
  intuition.
  eapply ratInverse_nz.
  eauto.

  edestruct (H2 ((ratInverse (1 + c1)) * epsilon * (1 / 2))).
  intuition.
  apply ratMult_0 in H5.
  intuition.
  apply ratMult_0 in H6.
  intuition.
  eapply ratInverse_nz.
  eauto.

  edestruct (H2 1).
  intuition.

  exists (maxList (x :: x0 :: x1 :: nil)).
  intuition.
  unfold ratMult_rel in *.
  edestruct H.
  edestruct H0.
  rewrite H8; eauto.
  eapply leRat_trans.
  eapply (ratTriangleInequality _ _ (c1 * x3)).

  rewrite ratMult_ratDistance_factor_r.
  rewrite ratMult_ratDistance_factor_l.
  rewrite ratMult_comm.
  eapply leRat_trans.
  eapply ratAdd_leRat_compat.
  eapply ratMult_leRat_compat.
  eapply ratDistance_le_sum.
  eapply H6; [idtac | eapply H10].
  eapply le_trans.
  eapply (maxList_correct (x :: x0 :: x1 :: nil)).
  simpl.
  intuition.
  trivial.
  eapply H4; [idtac | eapply H9].
  eapply le_trans.
  eapply (maxList_correct (x :: x0 :: x1 :: nil)).
  simpl.
  intuition.
  trivial.
  eapply ratMult_leRat_compat.
  eapply (ratAdd_any_leRat_l 1).
  eapply leRat_refl.
  eapply H5; [idtac | eapply H10].
  eapply le_trans.
  eapply (maxList_correct (x :: x0 :: x1 :: nil)).
  simpl.
  intuition.
  trivial.
  eapply eqRat_impl_leRat.
  repeat rewrite <- ratMult_assoc.
  rewrite (ratAdd_comm c2).
  rewrite (ratAdd_comm c1).
  rewrite (ratMult_assoc ((1 + c2) * (ratInverse (1 + c2)))).
  rewrite (ratMult_assoc ((1 + c1) * (ratInverse (1 + c1)))).
  rewrite <- ratMult_distrib_r.
  rewrite (ratMult_comm (1 + c2)).
  rewrite (ratMult_comm (1 + c1)).
  repeat rewrite ratInverse_prod_1.
  rewrite ratMult_2.
  rewrite ratMult_1_l.
  rewrite ratMult_comm.
  rewrite ratMult_assoc.

  rewrite ratMult_eq_rat1.
  eapply ratMult_1_r.

  intuition.
  assert (1 <= 0).
  eapply leRat_trans.
  eapply (ratAdd_any_leRat_r c1).
  eapply leRat_refl.
  eapply eqRat_impl_leRat.
  rewrite ratAdd_comm.
  trivial.
  intuition.

  intuition.
  assert (1 <= 0).
  eapply leRat_trans.
  eapply (ratAdd_any_leRat_r c2).
  eapply leRat_refl.
  eapply eqRat_impl_leRat.
  rewrite ratAdd_comm.
  trivial.
  intuition.

Qed.

Definition rat_limit(f : Rat -> Rat -> Prop)(p L : Rat) :=
  forall epsilon,
    ~ (epsilon == 0) ->
    exists delta, (~delta == 0) /\
      forall x v,
        f x v ->
        (ratDistance x p) <= delta ->
        (ratDistance v L) <= epsilon.

Definition continuous_at(f : Rat -> Rat -> Prop)(c : Rat) :=
  forall v, f c v ->
    rat_limit f c v.

Lemma rat_inf_limit_comp : forall (f : nat -> Rat -> Prop)(g : Rat -> Rat -> Prop) a v,
  rat_inf_limit f a ->
  g a v ->
  continuous_at g a ->
  left_total f ->
  rat_inf_limit (fun n r => forall v', (f n v' -> g v' r)) v.

  unfold continuous_at, rat_limit, rat_inf_limit, inf_limit in *.
  intuition.
  edestruct H1; eauto.
  intuition.
  destruct (H x).
  trivial.
  exists x0.
  intuition.
  destruct (H2 n').
  eapply H6.
  eauto.
  eapply H4.
  eapply H7.
  trivial.
Qed.

Lemma rat_inf_limit_trans : forall (f1 f2 : nat -> Rat -> Prop) a,
  rat_inf_limit_2 f1 f2 ->
  rat_inf_limit f2 a ->
  left_total f2 ->
  rat_inf_limit f1 a.

  intuition.
  unfold rat_inf_limit_2, inf_limit_2, rat_inf_limit, inf_limit in *.
  intuition.
  edestruct (H (ratHalf epsilon)).
  eapply ratHalf_ne_0.
  intuition.
  edestruct (H0 (ratHalf epsilon)).
  eapply ratHalf_ne_0.
  intuition.
  exists (Max.max x x0).
  intuition.
  destruct (H1 n').
  eapply leRat_trans.
  eapply ratTriangleInequality.
  rewrite H3.
  rewrite H4.
  rewrite ratHalf_add.
  intuition.
  eapply Max.max_lub_r.
  eauto.
  eauto.
  eapply Max.max_lub_l.
  eauto.
  trivial.
  trivial.
Qed.

Lemma rat_inf_limit_eq : forall f a1 a2,
  rat_inf_limit f a1 ->
  a1 == a2 ->
  rat_inf_limit f a2.

  unfold rat_inf_limit, inf_limit in *.
  intuition.
  edestruct H; eauto.
  exists x.
  intuition.
  rewrite <- H0.
  eapply H2.
  eapply H3.
  trivial.
Qed.

Lemma rat_inf_limit_const : forall (f : Rat -> Prop) a,
  f a ->
  (forall a1 a2, f a1 -> f a2 -> a1 == a2) ->
  rat_inf_limit (fun _ => f) a.

  unfold rat_inf_limit, inf_limit in *.
  intuition.
  exists O.
  intuition.
  eapply leRat_trans.
  eapply eqRat_impl_leRat.
  rewrite <- ratIdentityIndiscernables.
  eauto.
  eapply rat0_le_all.

Qed.

Lemma rat_inf_limit_summation : forall (A : Set)(f1 : A -> nat -> Rat -> Prop)(f2 : A -> Rat)(ls : list A),
  (forall a, rat_inf_limit (f1 a) (f2 a)) ->
  (forall a, left_total (f1 a)) ->
  (forall a n r1 r2, f1 a n r1 -> f1 a n r2 -> r1 == r2) ->
  rat_inf_limit
  (fun n : nat => sumList_rel (fun a0 : A => f1 a0 n) ls)
  (sumList ls f2).

  induction ls; intuition.
  unfold rat_inf_limit, inf_limit.
  intuition.
  exists O.
  intuition.
  inversion H4; clear H4; subst.
  unfold sumList.
  simpl.
  rewrite H5.
  eapply leRat_trans.
  eapply eqRat_impl_leRat.
  rewrite <- ratIdentityIndiscernables.
  intuition.
  eapply rat0_le_all.

  eapply (@rat_inf_limit_trans _ (fun n : nat => ratAdd_rel (f1 a n) (sumList_rel (fun a0 : A => f1 a0 n) ls))).
  unfold rat_inf_limit_2, inf_limit_2.
  intuition.
  exists O.
  intuition.
  inversion H5; clear H5; subst.
  unfold ratAdd_rel in *.
  rewrite H6.
  rewrite H12.
  eapply leRat_trans.
  eapply eqRat_impl_leRat.
  rewrite <- ratIdentityIndiscernables.
  eapply eqRat_refl.
  eapply rat0_le_all.
  trivial.
  trivial.
  eapply rat_inf_limit_eq.
  eapply rat_inf_limit_sum.
  eauto.
  unfold left_total; intuition.
  eapply sumList_rel_left_total.
  intuition.
  eapply H0.
  eapply H.
  eauto.
  unfold sumList.
  simpl.
  symmetry.
  rewrite fold_add_body_eq; [idtac | eapply ratAdd_comm | idtac].
  rewrite fold_add_init.
  eapply eqRat_refl.
  intuition.

  unfold left_total; intuition.
  eapply ratAdd_rel_left_total.
  eapply H0.
  eapply sumList_rel_left_total.
  intuition.
  eapply H0.
  eauto.
  intuition.
  eapply sumList_rel_func; eauto.
  intuition.
  eauto.
Qed.

Lemma ratInverse_continuous : forall c,
  ~ c == 0 ->
  continuous_at (fun v' r : Rat => r == ratInverse v') c.

  unfold continuous_at, rat_limit in *.
  intuition.

  exists (minRat (c * (1 / 2)) (c * (1/2) * c * epsilon)).
  intuition.
  unfold minRat in *.
  destruct (bleRat (c * (1 / 2)) (c * (1 / 2) * c * epsilon)).
  apply ratMult_0 in H2; intuition.
  apply ratMult_0 in H2; intuition.
  apply ratMult_0 in H3; intuition.
  apply ratMult_0 in H2; intuition.

  rewrite H2.
  rewrite H0.

  assert (ratDistance x c <= c * (1/2)).
  eapply leRat_trans.
  eapply H3.
  eapply minRat_le_l.

  assert (ratSubtract c (c * (1/2)) <= x).
  eapply ratDistance_ge_difference.
  rewrite ratDistance_comm.
  trivial.
  assert (x <= c + (c * (1/2))).
  eapply ratDistance_le_sum.
  trivial.
  assert (c * (1/2) <= x).

  rewrite <- (ratSubtract_half).
  trivial.

  clear H5.
  assert (x <= c * (3/2)).

  rewrite ratMult_ratAdd_cd in H6.
  simpl in *.
  trivial.

  clear H6.
  assert (ratInverse x <= ratInverse (c * (1 / 2))).
  apply ratInverse_leRat.
  intuition.
  apply ratMult_0 in H6; intuition.
  trivial.

  rewrite ratDistance_ratInverse.
  rewrite H3.
  rewrite minRat_le_r.

  rewrite ratInverse_ratMult; intuition.
  rewrite H6.
  rewrite ratInverse_ratMult; intuition.
  rewrite ratMult_comm.
  repeat rewrite <- ratMult_assoc.
  rewrite (ratMult_assoc ((ratInverse c) * (ratInverse (1/2)))).
  rewrite ratInverse_prod_1; intuition.
  rewrite ratMult_1_r.
  rewrite (ratMult_assoc (ratInverse c)).
  rewrite ratInverse_prod_1; intuition.
  rewrite ratMult_1_r.
  rewrite ratInverse_prod_1; intuition.
  rewrite ratMult_1_l.
  intuition.
  rewrite H8 in H7.
  assert (c * (1 / 2) == 0).
  eapply leRat_impl_eqRat.
  trivial.
  eapply rat0_le_all.
  apply ratMult_0 in H9; intuition.
  intuition.
  rewrite H8 in H7.
  assert (c * (1 / 2) == 0).
  eapply leRat_impl_eqRat.
  trivial.
  eapply rat0_le_all.
  apply ratMult_0 in H9; intuition.
  intuition.
Qed.

Lemma rat_inf_limit_ratInverse : forall (f : nat -> Rat -> Prop) a v,
  rat_inf_limit f a ->
  ~ a == 0 ->
  ratInverse a == v ->
  left_total f ->
  rat_inf_limit (fun n => ratInverse_rel (f n)) v.

  intuition.
  eapply rat_inf_limit_comp.
  eauto.
  symmetry.
  trivial.
  eapply ratInverse_continuous.
  trivial.
  trivial.

Qed.

Lemma rat_inf_limit_exp_0 : forall (f : nat -> Rat -> Prop) a,
  rat_inf_limit f a ->
  ~ 1 <= a ->
  (forall n, exists r, f n r) ->
  rat_inf_limit (fun n => (expRat_rel (f n) n)) 0.

  intuition.
  unfold rat_inf_limit, inf_limit in *.
  intuition.
  edestruct (H (1 / 2 * (ratSubtract 1 a))); eauto.
  intuition.
  apply ratMult_0 in H3.
  intuition.
  eapply H0.
  eapply ratSubtract_0_inv.
  trivial.

  edestruct (@expRat_le_exp_exists (a + (1 / 2) * (ratSubtract 1 a)) epsilon).
  eapply half_distance_1_le; trivial.
  trivial.

  exists (Max.max x x0).
  intuition.
  unfold expRat_rel in *.
  destruct (H1 n').
  rewrite H6; eauto.

  apply ratDistance_0_r_le.
  eapply leRat_trans.
  eapply expRat_leRat_compat.
  eapply ratDistance_le_sum.
  eapply H3.
  eapply Max.max_lub_l.
  eauto.
  trivial.

  eapply expRat_le'.
  eauto.
  eapply half_distance_1_le; trivial.
  eapply Max.max_lub_r.
  eauto.

Qed.

Lemma power_series_limit_2 : forall (f : nat -> Rat -> Prop) a,
  rat_inf_limit f a ->
  (forall n v, f n v -> ~ 1 <= v) ->
  ~ 1 <= a ->
  (forall n, exists v, f n v) ->
  (forall n v1 v2, f n v1 -> f n v2 -> v1 == v2) ->
  rat_inf_limit
  (fun n => sumList_rel
    (fun i => expRat_rel (f n) i)
    (getNats O n))
  (ratInverse (ratSubtract 1 a)).

  intuition.

  eapply (@rat_inf_limit_trans _ (fun n => (ratMult_rel (ratSubtract_rel (eqRat 1) (expRat_rel (f n) n)) (ratInverse_rel (ratSubtract_rel (eqRat 1) (f n)))))).
  unfold rat_inf_limit_2, inf_limit_2.
  intuition.
  exists (S O).
  intuition.
  destruct (H2 n').
  eapply leRat_trans.
  eapply eqRat_impl_leRat.
  rewrite <- ratIdentityIndiscernables.
  eapply sum_power_series.
  assert (n' > O).
  omega.
  eapply H9.
  econstructor.
  eapply H8.
  eapply H3.
  intuition.
  eapply H0.
  eapply H9.
  trivial.
  trivial.
  trivial.
  eapply rat0_le_all.

  eapply rat_inf_limit_eq.
  eapply rat_inf_limit_product.

  unfold left_total, ratSubtract_rel, expRat_rel. intuition.
  destruct (H2 n).
  exists (ratSubtract 1 (expRat x n)).
  intuition.
  eapply ratSubtract_eqRat_compat; eauto.
  symmetry.
  eapply H6.
  trivial.

  unfold left_total, ratInverse_rel, ratSubtract_rel. intuition.
  destruct (H2 n).
  exists (ratInverse (ratSubtract 1 x)).
  intuition.
  eapply ratInverse_eqRat_compat.
  intuition.
  eapply H0.
  eauto.
  eapply ratSubtract_0_inv.
  trivial.

  symmetry.
  eapply H5; intuition.

  eapply rat_inf_limit_difference.

  unfold left_total; intuition.
  exists 1; intuition.

  unfold left_total, expRat_rel; intuition.
  destruct (H2 n).
  exists (expRat x n).
  intuition.

  eapply expRat_eqRat_compat; eauto.

  eapply rat_inf_limit_const.
  eapply eqRat_refl.
  intuition.
  rewrite <- H4.
  rewrite H5.
  intuition.

  eapply rat_inf_limit_exp_0.
  eauto.
  trivial.
  trivial.

  eapply rat_inf_limit_ratInverse.
  eapply rat_inf_limit_difference.
  unfold left_total; intuition.
  econstructor.
  eapply eqRat_refl.
  unfold left_total; intuition.

  eapply rat_inf_limit_const.
  eapply eqRat_refl.
  intuition.
  rewrite <- H4.
  rewrite H5.
  intuition.
  eauto.
  intuition.
  eapply H1.
  eapply ratSubtract_0_inv.
  trivial.

  eapply eqRat_refl.
  unfold left_total; intuition.
  destruct (H2 n).
  exists (ratSubtract 1 x).
  unfold ratSubtract_rel; intuition.
  eapply ratSubtract_eqRat_compat; eauto.
  rewrite ratSubtract_0_r.
  rewrite ratMult_1_l.
  intuition.

  unfold left_total, ratMult_rel, ratSubtract_rel, expRat_rel, ratInverse_rel.
  intuition.
  destruct (H2 n).
  exists ((ratSubtract 1 (expRat x n)) * (ratInverse (ratSubtract 1 x))).
  intuition.
  eapply ratMult_eqRat_compat.
  symmetry.
  eapply H5;
  intuition.
  eapply expRat_eqRat_compat.
  eauto.
  symmetry.
  eapply H6.
  intuition.
  eapply ratSubtract_eqRat_compat; intuition.
  eauto.
Qed.

Lemma rat_inf_limit_mono  : forall (f : nat -> Rat -> Prop) (g : nat -> nat)(v : Rat),
    rat_inf_limit f v ->
    (forall n1 n2, n1 <= n2 -> g n1 <= g n2)%nat ->
    (forall y, exists x, g x = y) ->
    rat_inf_limit (fun n => f (g n)) v.

  unfold rat_inf_limit, inf_limit.
  intuition.
  destruct (H epsilon); intuition.
  destruct (H1 x).
  econstructor.
  intuition.
  eapply (H3 (g n')).
  eapply le_trans.
  Focus 2.
  eapply H0.
  eapply H5.
  rewrite <- H4.
  eapply le_refl.
  trivial.
Qed.

Lemma rat_inf_limit_sqrt:
  forall (f : nat -> Rat -> Prop) (v : Rat),
    rat_inf_limit f v ->
    rat_inf_limit (fun n => f (sqrt n)) v.

  intuition.
  eapply rat_inf_limit_mono.
  trivial.
  intuition.
  eapply Nat.sqrt_le_mono.
  trivial.
  intuition.
  econstructor.
  eapply Nat.sqrt_square.
Qed.


(**
This file is part of the Coq.Interval library for proving bounds of
real-valued expressions in Coq: http://coq-interval.gforge.inria.fr/

Copyright (C) 2013-2016, Inria

This library is governed by the CeCILL-C license under French law and
abiding by the rules of distribution of free software. You can use,
modify and/or redistribute the library under the terms of the CeCILL-C
license as circulated by CEA, CNRS and Inria at the following URL:
http://www.cecill.info/

As a counterpart to the access to the source code and rights to copy,
modify and redistribute granted by the license, users are provided
only with a limited warranty and the library's author, the holder of
the economic rights, and the successive licensors have only limited
liability. See the COPYING file for more details.
*)

From Coq Require Import Reals.

Require Import Interval.
Require Import Xreal.

Module Type UnivariateApprox (I : IntervalOps).

(* Local Coercion I.convert : I.type >-> interval. *)

Parameter T : Type.

Definition U := (I.precision * nat (* for degree *) )%type.

Parameter approximates : I.type -> T -> (R -> ExtendedR) -> Prop.

Parameter approximates_ext :
  forall f g xi t,
  (forall x, f x = g x) ->
  approximates xi t f -> approximates xi t g.

Parameter const : I.type -> T.

Parameter const_correct :
  forall (c : I.type) (r : R), contains (I.convert c) (Xreal r) ->
  forall (X : I.type),
  approximates X (const c) (fun _ => Xreal r).

Parameter dummy : T.

Parameter dummy_correct :
  forall xi f, approximates xi dummy f.

Parameter var : T.

Parameter var_correct :
  forall (X : I.type), approximates X var Xreal.

Parameter eval : U -> T -> I.type -> I.type -> I.type.

Parameter eval_correct :
  forall u (Y : I.type) t f,
  approximates Y t f -> I.extension (Xbind f) (eval u t Y).

(*
Parameter prim : U -> I.type -> I.type -> I.type -> T -> T.

Parameter prim_correct :
  forall u (X X1 Y1 : I.type) tf f f0 x1 y1,
  contains (I.convert X1) (Xreal x1) ->
  contains (I.convert Y1) (Xreal y1) ->
  approximates X tf f ->
  (forall r : R, f0 r = toR_fun f r) ->
  approximates X (prim u X X1 Y1 tf) (fun x => match x with
                                         | Xnan => Xnan
                                         | Xreal r => Xreal (RInt f0 x1 r + y1)
                                         end).
*)

Parameter add : U -> I.type -> T -> T -> T.

Parameter add_correct :
  forall u (Y : I.type) tf tg f g,
  approximates Y tf f -> approximates Y tg g ->
  approximates Y (add u Y tf tg) (fun x => Xadd (f x) (g x)).

Parameter opp : U -> I.type -> T -> T.

Parameter opp_correct :
  forall u (Y : I.type) tf f,
  approximates Y tf f ->
  approximates Y (opp u Y tf) (fun x => Xneg (f x)).

Parameter sub : U -> I.type -> T -> T -> T.

Parameter sub_correct :
  forall u (Y : I.type) tf tg f g,
  approximates Y tf f -> approximates Y tg g ->
  approximates Y (sub u Y tf tg) (fun x => Xsub (f x) (g x)).

Parameter mul : U -> I.type -> T -> T -> T.

Parameter mul_correct :
  forall u (Y : I.type) tf tg f g,
  approximates Y tf f -> approximates Y tg g ->
  approximates Y (mul u Y tf tg) (fun x => Xmul (f x) (g x)).

Parameter abs : U -> I.type -> T -> T.

Parameter abs_correct :
  forall u (Y : I.type) tf f,
  approximates Y tf f ->
  approximates Y (abs u Y tf) (fun x => Xabs (f x)).

Parameter div : U -> I.type -> T -> T -> T.

Parameter div_correct :
  forall u (Y : I.type) tf tg f g,
  approximates Y tf f -> approximates Y tg g ->
  approximates Y (div u Y tf tg) (fun x => Xdiv (f x) (g x)).

Parameter inv : U -> I.type -> T -> T.

Parameter inv_correct :
  forall u (Y : I.type) tf f,
  approximates Y tf f ->
  approximates Y (inv u Y tf) (fun x => Xinv (f x)).

Parameter sqrt : U -> I.type -> T -> T.

Parameter sqrt_correct :
  forall u (Y : I.type) tf f,
  approximates Y tf f ->
  approximates Y (sqrt u Y tf) (fun x => Xsqrt (f x)).

Parameter exp : U -> I.type -> T -> T.

Parameter exp_correct :
  forall u (Y : I.type) tf f,
  approximates Y tf f ->
  approximates Y (exp u Y tf) (fun x => Xexp (f x)).

Parameter ln : U -> I.type -> T -> T.

Parameter ln_correct :
  forall u (Y : I.type) tf f,
  approximates Y tf f ->
  approximates Y (ln u Y tf) (fun x => Xln (f x)).

Parameter cos : U -> I.type -> T -> T.

Parameter cos_correct :
  forall u (Y : I.type) tf f,
  approximates Y tf f ->
  approximates Y (cos u Y tf) (fun x => Xcos (f x)).

Parameter sin : U -> I.type -> T -> T.

Parameter sin_correct :
  forall u (Y : I.type) tf f,
  approximates Y tf f ->
  approximates Y (sin u Y tf) (fun x => Xsin (f x)).

Parameter tan : U -> I.type -> T -> T.

Parameter tan_correct :
  forall u (Y : I.type) tf f,
  approximates Y tf f ->
  approximates Y (tan u Y tf) (fun x => Xtan (f x)).

Parameter atan : U -> I.type -> T -> T.

Parameter atan_correct :
  forall u (Y : I.type) tf f,
  approximates Y tf f ->
  approximates Y (atan u Y tf) (fun x => Xatan (f x)).

End UnivariateApprox.


Require Import Reals.
Local Open Scope R_scope.
From ValidSDP Require Import validsdp.
Require Import Psatz.

Let p (x0 x1 x2 x3 x4 x5 : R) :=
  0
  - (x0 * x3 * (0 - x0 + x1 + x2 - x3 + x4 + x5)
     + x1 * x4 * (x0 - x1 + x2 + x3 - x4 + x5)
     + x2 * x5 * (x0 + x1 - x2 + x3 + x4 - x5) - x1 * x2 * x3 - x0 * x2 * x4
     - x0 * x1 * x5 - x3 * x4 * x5).

Let p' (x0 x1 x2 x3 x4 x5 : R) :=
  7/50
  + x0 * x3 * (0 - x0 + x1 + x2 - x3 + x4 + x5)
    + x1 * x4 * (x0 - x1 + x2 + x3 - x4 + x5)
    + x2 * x5 * (x0 + x1 - x2 + x3 + x4 - x5) - x1 * x2 * x3 - x0 * x2 * x4
    - x0 * x1 * x5 - x3 * x4 * x5.

Let p'' (x0 x1 x2 x3 x4 x5 : R) :=
  -25
  + (0 - x1) * x2 - x0 * x3 + x1 * x4 + x2 * x5 - x4 * x5
    + x0 * (0 - x0 + x1 + x2 - x3 + x4 + x5).

Let b1 (x0 x1 x2 x3 x4 x5 : R) :=
  (x0 - 606887582536/100000000000) * (702674064/100000000 - x0).

Let b2 (x0 x1 x2 x3 x4 x5 : R) :=
  (x1 - 4) * (8 - x1).

Let b3 (x0 x1 x2 x3 x4 x5 : R) :=
  (x2 - 2) * (2 - x2).

Let b4 (x0 x1 x2 x3 x4 x5 : R) :=
  (x3 - 2) * (2 - x3).

Let b5 (x0 x1 x2 x3 x4 x5 : R) :=
  (x4 - 2) * (2 - x4).

Let b6 (x0 x1 x2 x3 x4 x5 : R) :=
  (x5 - 4) * (8 - x5).

Theorem alternative (x0 x1 x2 x3 x4 x5 : R) :
  b1 x0 x1 x2 x3 x4 x5 >= 0 ->
  b2 x0 x1 x2 x3 x4 x5 >= 0 ->
  b3 x0 x1 x2 x3 x4 x5 >= 0 ->
  b4 x0 x1 x2 x3 x4 x5 >= 0 ->
  b5 x0 x1 x2 x3 x4 x5 >= 0 ->
  b6 x0 x1 x2 x3 x4 x5 >= 0 ->
  (p x0 x1 x2 x3 x4 x5 > 0
   \/ p' x0 x1 x2 x3 x4 x5 > 0).
Proof.
intros H1 H2 H3 H4 H5 H6.
case (Rlt_or_le 0 (p x0 x1 x2 x3 x4 x5)) => Hp; [now left|right].
revert H1 H2 H3 H4 H5 H6 Hp.
unfold b1, b2, b3, b4, b5, b6, p, p'.
validsdp.
Qed.


Require Export D.

(** 1 star, optional (iff_properties)  *)
(** Using the above proof that [<->] is symmetric ([iff_sym]) as
    a guide, prove that it is also reflexive and transitive. *)
(** Hint: If you have an iff hypothesis in the context, you can use
    [inversion] to break it into two separate implications.  (Think
    about why this works.) *)

Theorem iff_refl : forall P : Prop,
  P <-> P.
Proof.
  intros P. split. intros. apply H.  intros. apply H.
Qed.


Inductive type : Type :=
| base  : type
| arrow : type -> type -> type
.

Notation "a ~> b" := (arrow a b) (at level 20, b at next level).

Inductive assumption : Type :=
| assume : nat -> type -> assumption
.

Notation "x :: t" := (assume x t).

Inductive ctx : Type :=
| empty : ctx
| snoc  : ctx -> assumption -> ctx
.

Notation "G , a" := (snoc G a) (at level 70, a at next level).

Fixpoint conc (G D:ctx) : ctx :=
    match D with
    | empty     => G
    | snoc D' x => snoc (conc G D') x
    end.

Notation "G ; D" := (conc G D) (at level 20).

Inductive term : Type :=
| tVar : nat  -> type -> term
| tApp : term -> term -> term
| tLam : nat  -> type -> term -> term
.

Inductive infer : ctx -> term -> type -> Prop :=
| iVar: forall G x T,
    (*------------------------*)
        infer G (tVar x T) T

| iApp: forall G s t S T,
        infer G t (S ~> T) -> infer G s S
    (*-------------------------------------*)
    ->  infer G (tApp t s) T

| iLam: forall G x t S T,
        infer (G, x :: S) t T
    (*--------------------------------*)
    ->  infer G (tLam x S t) (S ~> T)
| iWeak: forall G x t S T,
        infer G t T
    (*------------------------*)
    ->  infer (G, x :: S) t T

| iBeta: forall G x t S T,
    infer G (tLam x S t) (S ~> T)
 (*-------------------------------*)
    ->  infer (G, x :: S) t T
.

Notation "G |- t $ T" := (infer G t T) (at level 20).

Lemma weakening : forall G D x t S T,
        (G ; D) |- t $ T
    (*---------------------------*)
    -> ((G, x :: S); D) |- t $ T.
Proof.
    intros G. induction D as [|D IH a].
    - simpl. intros x t S T H. constructor. assumption.
    - simpl. destruct a as [u U]. intros x t S T H. apply iBeta, IH, iLam.
      assumption.
Qed.


(* Practica 1 *)

Section P1.
Variables A B C:Prop.

(* Ej 1.1 *)
Theorem e11: A->A.
Proof.
  intro.
  assumption.
Qed.

(* Ej 1.2 *)
Theorem e12: A->B->A.
Proof.
  intros.
  assumption.
Qed.

(* Ej 1.3 *)
Theorem e13: (A->(B->C))->(A->B)->(A->C).
Proof.
  intros.
  apply H.
  assumption.
  apply H0.
  assumption.
Qed.

(*Ej 2.1 *)
Theorem e21: (A->B)->(B->C)->A->C.
Proof.
  intros.
  apply H0.
  apply H.
  assumption.
Qed.

(*Ej 2.2 *)
Theorem e22: (A->B->C)->B->A->C.
Proof.
  intros.
  apply H.
  assumption.
  assumption.

Qed.

(*Ej 3.1 *)
Theorem e31: A->A->A.
Proof.
  intros.
  assumption.

Qed.

Theorem e31b: A->A->A.
Proof.
  intro H.
  intro G.
  assumption.
Qed.

(* Ej 3.2 *)
Theorem e32: (A->B->C)->A->(A->C)->B->C.
Proof.
  intros.
  apply H1.
  assumption.
Qed.

Theorem e32b: (A->B->C)->A->(A->C)->B->C.
Proof.
  intro G.
  intro H.
  intro I.
  apply G.
  assumption.
Qed.

(* Ej 4.1 *)
Theorem e41: A -> ~~A.
Proof.
  intro H.
  intro G.
  absurd A.
  assumption.
  assumption.
Qed.

(* Ej 4.2 *)
Theorem e42: A -> B -> (A /\ B).
Proof.
  intro G.
  intro H.
  split.
  assumption.
  assumption.
Qed.

(* Ej 4.3 *)
Theorem e43: (A->B->C) -> (A/\B->C).
Proof.
  intro G.
  intro H.
  apply G.
  elim H.
  intros.
  assumption.
  elim H.
  intros.
  assumption.
Qed.

(* Ej 4.4 *)
Theorem e44: A->(A\/B).
Proof.
  intro G.
  left.
  assumption.
Qed.

(* Ej 4.5 *)
Theorem e45: B->(A\/B).
Proof.
  intro G.
  right.
  assumption.
Qed.

(* Ej 4.6 *)
Theorem e46: (A \/ B) -> (B \/ A).
Proof.
  intro G.
  elim G.
  intro H.
  right.
  assumption.
  intro H.
  left.
  assumption.
Qed.

(* Ej 4.7 *)
Theorem e47: (A->C)->(B->C)->A\/B->C.
Proof.
  intro G.
  intro H.
  intro I.
  elim I.
  assumption.
  assumption.
Qed.

(* Ej 4.8 *)
Theorem e48: False->A.
Proof.
  intro H.
  elim H.
Qed.

(* Ej 5.1 *)
Theorem e51: (A->B)-> ~B-> ~A.
Proof.
  intro G.
  intro H.
  intro I.
  absurd B.
  assumption.
  apply G.
  assumption.
Qed.

(* Ej 5.2 *)
Theorem e52: ~(A/\~A).
Proof.
  intro G.
  elim G.
  intro H.
  intro I.
  absurd A.
  assumption.
  assumption.
Qed.

(* Ej 5.3 *)
Theorem e53: (A->B)-> ~(A/\~B).
Proof.
  intro G.
  intro I.
  elim I.
  intros.
  absurd B.
  assumption.
  apply G.
  assumption.
Qed.

(* Ej 5.4 *)
Theorem e54: (A/\B)->~(A->~B).
Proof.
  intro G.
  intro H.
  elim G.
  intros.
  absurd B.
  apply H.
  assumption.
  assumption.
Qed.

(* Ej 5.5 *)
Theorem e55: (~A /\ ~~A) -> False.
Proof.
  intro G.
  elim G.
  intros.
  absurd A.
  assumption.
  elim H0.
  assumption.
Qed.

(* Ej 6.1 *)
Theorem e61: (A\/B) -> ~(~A/\~B).
Proof.
  intro G.
  intro H.
  elim H.
  intros.
  elim G.
  apply H0.
  apply H1.
Qed.

(* Ej 6.2 *)
Theorem e62: A\/B <-> B\/A.
Proof.
  unfold iff.
  split.
  intro G.
  elim G.
  intro H.
  right.
  assumption.
  intro H.
  left.
  assumption.
  intro G.
  elim G.
  intro H.
  right.
  assumption.
  intro H.
  left.
  assumption.
Qed.

(* Ej 6.3 *)
Theorem e63: A\/B -> ((A->B)->B).
Proof.
  intro G.
  intros.
  elim G.
  assumption.
  intro.
  assumption.
Qed.

End P1.

Section Logica_Clasica.
Variables A B C: Prop.

(* Ej 7.1 *)
Theorem e71: A \/ ~A -> ~~A->A.
Proof.
  intros.
  elim H.
  intro I.
  assumption.
  intro I.
  elim H0.
  assumption.
Qed.

(* Ej 7.2 *)
Theorem e72: A\/~A -> ((A->B) \/ (B->A)).
Proof.
  intros.
  elim H.
  intros.
  right.
  intro I.
  assumption.
  intro I.
  left.
  intro J.
  absurd A.
  assumption.
  assumption.
Qed.

(* Ej 7.3 *)
Theorem e73: (A \/ ~A) -> ~(A /\ B) -> ~A \/ ~B.
Proof.
  intros.
  elim H.
  intro.
  right.
  intro.
  unfold not in H0.
  apply H0.
  split.
  assumption.
  assumption.
  intro.
  left.
  assumption.

Qed.

Require Import Classical.
Check classic.

(* Ej 8.1 *)
Theorem e81: ~~A->A.
Proof.
  intro.
  elim (classic (A)).
  intro.
  assumption.
  intro.
  elim H.
  assumption.
Qed.

(* Ej 8.2 *)
Theorem e82: (A->B)\/(B ->A).
Proof.
  elim (classic (A)).
  intros.
  right.
  intro.
  assumption.
  intro.
  left.
  intro.
  absurd A.
  assumption.
  assumption.
Qed.

(* Ej 8.3 *)
Theorem e83: ~(A/\B)-> ~A \/ ~B.
Proof.
  intro.
  elim (classic (A)).
  intro.
  right.
  intro.
  unfold not in H.
  apply H.
  split.
  assumption.
  assumption.
  intro.
  left.
  assumption.
Qed.

End Logica_Clasica.

Section ejercicio10.
(* Ej 10 *)
(* Definicion *)
Variable E:Prop.   (* Es escoces *)
Variable MR:Prop.  (* Usa medias rojas *)
Variable K: Prop.  (* Usa kilt *)
Variable C: Prop.  (* Esta casado *)
Variable SD: Prop. (* Sale los domingos *)

Hypothesis Regla1: ~E -> MR.
Hypothesis Regla2: K \/ ~MR.
Hypothesis Regla3: C -> ~SD.
Hypothesis Regla4: SD <-> E.
Hypothesis Regla5: K -> E /\ C.
Hypothesis Regla6: E -> K.

Theorem ej10: False.
Proof.
  unfold iff in Regla4.

  elim Regla2.
  intro.
  apply Regla3.

  elim Regla5.
  intros.
  assumption.
  assumption.

  elim Regla4.
  intros.
  apply H1.

  elim Regla5.
  intros.

  assumption.

  assumption.

  intro.
  apply H.
  apply Regla1.
  intro.
  elim Regla4.
  intros.
  apply Regla3.

  elim Regla5.

  intros.
  assumption.

  apply Regla6.
  assumption.

  apply H2.
  assumption.
Qed.

End ejercicio10.

Section ejercicio11.

(* Ej 11 *)
(* Definiciones *)
Variable PF:Prop. (*el paciente tiene fiebre*)
Variable PA:Prop. (*el paciente tiene piel amarillenta*)
Variable PH:Prop. (*el paciente tiene hepatitis*)
Variable PR:Prop. (*el paciente tiene rubeola*)

Hypothesis Regla1: PF \/ PA -> PH \/ PR.
Hypothesis Regla2: PR -> PF.
Hypothesis Regla3: PH /\ ~PR -> PA.

Theorem ej11: (~PA /\ PF) -> PR.
Proof.
  intro.
  elim H.
  intros.

  assert (~ (PH /\ ~ PR)).
  intro.
  elim H2.
  intros.
  apply H0.
  apply Regla3.
  split.
  assumption.
  assumption.

  apply e83 in H2.

  elim H2.
  intro.

  elim Regla1.

  intro.
  contradiction.

  intro.
  assumption.

  left.
  assumption.

  intro.
  apply e81 in H3.
  assumption.
Qed.

End ejercicio11.


From Coq Require Import Arith.
From mathcomp Require Import ssreflect eqtype ssrfun ssrnat ssrbool seq.
From ssrlib Require Import Nats FSets.

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

Module S := MakeTreeSet NatOrder.

  Lemma subset_cardinal s1 s2 :
    S.subset s1 s2 -> S.cardinal s1 <= S.cardinal s2.
  Proof.
    move=> Hsub. apply: le_leq. apply: S.Lemmas.OP.P.subset_cardinal.
    apply: S.TS.subset_2. assumption.
  Qed.

  Lemma uniq_of_list_cardinal xs :
    uniq xs -> S.cardinal (S.Lemmas.OP.P.of_list xs) = size xs.
  Proof.
    elim: xs => [| x xs IH] //=. move/andP=> [Hnotin Huniq].
    rewrite S.Lemmas.P.add_cardinal_2.
    - rewrite (IH Huniq). reflexivity.
    - move/S.Lemmas.memP=> Hmem. rewrite -S.Lemmas.in_mem in Hmem.
      rewrite Hmem in Hnotin. discriminate.
  Qed.

Section Pigeonhole.

  Variable f : nat -> nat.

  Fixpoint below (n : nat) : S.t :=
    match n with
    | O => S.empty
    | S m => S.add m (below m)
    end.

  Lemma below_mem (n m : nat) : m < n -> S.mem m (below n).
  Proof.
    elim: n m => [| n IHn] m Hnm //=. rewrite ltnS leq_eqVlt in Hnm.
    case/orP: Hnm => Hnm.
    - apply: S.Lemmas.mem_add2. assumption.
    - apply: S.Lemmas.mem_add3. exact: (IHn _ Hnm).
  Qed.

  Lemma below_notin (n m : nat) : n <= m -> ~~ S.mem m (below n).
  Proof.
    elim: n m => [| n IHn] m Hnm //=. rewrite S.Lemmas.add_b negb_or.
    rewrite (IHn _ (ltnW Hnm)) andbT. apply/negP=> /S.Lemmas.eqb_eq Heq.
    rewrite (eqP Heq) ltnn in Hnm. discriminate.
  Qed.

  Lemma below_size n : S.cardinal (below n) = n.
  Proof.
    elim: n => [| n IHn] //=. rewrite S.Lemmas.P.add_cardinal_2.
    - by rewrite IHn.
    - move=> /S.Lemmas.memP Hmem. move: (below_notin (leqnn n)). rewrite Hmem.
      discriminate.
  Qed.

  Fixpoint find_same used n : bool * seq nat :=
    match n with
    | O => (false, used)
    | S m => if f m \in used then (true, used)
             else find_same (f m::used) m
    end.

  Lemma find_same_exists n used :
    find_same [::] n = (true, used) ->
    exists i1, exists i2, i1 < i2 /\ i2 < n /\ f i1 = f i2.
  Proof.
    move: (leqnn n).
    have: forall i, i < size ([::] : seq nat) ->
                    exists m, n <= m /\ m < n /\ f m = nth 0 [::] i.
    { move=> i /= H. by inversion H. }
    move: {2 4 6}n. move: [::].
    elim: n used => [| n IHn] //= oused iused max Hexists Hsize Hfind.
    case Hin: (f n \in iused) Hfind.
    - case => ?; subst. move: (Hin) => Hn. move/(nthP 0): Hin => [i Hi Hnthi].
      rewrite -Hnthi in Hn. move: (Hexists _ Hi) => [j [H1 [H2 H3]]].
      exists n; exists j. rewrite H1 H2 H3 Hnthi. done.
    - move=> Hfind. apply: (IHn oused (f n::iused) _ _ (ltnW Hsize) Hfind).
      move=> i Hi. case Hi0: (i == 0).
      + rewrite (eqP Hi0). exists n. rewrite leqnn Hsize /=. done.
      + rewrite /= ltnS in Hi. have H0i: 0 < i by rewrite lt0n Hi0.
        rewrite (Seqs.nth_cons _ _ _ H0i).
        move: (ltn_leq_trans H0i Hi) => Hsize0.
        have Hisize: i - 1 < size iused.
        { apply: (ltn_leq_trans _ Hi). rewrite -{2}(subn0 i). by apply: ltn_sub2l. }
        move: (Hexists _ Hisize) => [j [Hj1 [Hj2 Hj3]]].
        exists j. rewrite (ltnW Hj1) Hj2 Hj3. done.
  Qed.

  Lemma find_same_size n used :
    find_same [::] n = (false, used) -> size used = n.
  Proof.
    have: size ([::] : seq nat) = n - n by rewrite subnn.
    move: (leqnn n).
    move: [::]. move: {2 3 6}n => max.
    elim: n used => [| n IHn] /= oused iused Hmax Hs Hfind.
    - case: Hfind => ?; subst. rewrite Hs subn0. reflexivity.
    - case Hin: (f n \in iused) Hfind => //= Hfind.
      apply: (IHn _ (f n::iused) (ltnW Hmax) _ Hfind).
      rewrite /= Hs. rewrite subnS. rewrite (@ltn_predK 0); first reflexivity.
      rewrite subn_gt0. assumption.
  Qed.

  Lemma find_same_uniq n found used :
    find_same [::] n = (found, used) -> uniq used.
  Proof.
    have: uniq ([::] : seq nat) by done. move: [::].
    elim: n found used => [| n IHn] /= found oused iused.
    - move=> Hi [] ? ?; subst. assumption.
    - move=> Hi. case Hin: (f n \in iused).
      + case=> ? ?; subst. assumption.
      + move=> Hfind. apply: (IHn found oused (f n :: iused) _ Hfind).
        rewrite /=. rewrite Hi andbT. apply/negPf. assumption.
  Qed.

  Lemma find_same_subset n m used :
    (forall i, i < n -> f i < m) ->
    find_same [::] n = (false, used) ->
    S.subset (S.Lemmas.OP.P.of_list used) (below m).
  Proof.
    have: S.subset (S.Lemmas.OP.P.of_list [::]) (below m).
    { rewrite /=. exact: S.Lemmas.subset_empty. }
    move: ([::] : seq nat). elim: n used => [| n IHn] /= oused iused.
    - move=> Hsub Hfi [] ?; subst. assumption.
    - move=> Hsub Hfi. case Hin: (f n \in iused).
      + by case.
      + move=> Hfind. apply: (IHn _ (f n::iused) _ _ Hfind) => /=.
        * apply: S.Lemmas.subset_add3.
          -- apply: below_mem. apply: Hfi. exact: ltnSn.
          -- assumption.
        * move=> i Hi. apply: Hfi. rewrite ltnS. exact: (ltnW Hi).
  Qed.

  Lemma find_same_failed n m used :
    m < n ->
    (forall i, i < n -> f i < m) ->
    find_same [::] n = (false, used) -> False.
  Proof.
    move=> Hmn Hfi Hfind. move: (find_same_size Hfind) => Hn.
    move: (find_same_subset Hfi Hfind) => Hm.
    move: (subset_cardinal Hm). rewrite below_size.
    rewrite (uniq_of_list_cardinal (find_same_uniq Hfind)).
    rewrite Hn leqNgt Hmn. discriminate.
  Qed.

  Lemma pigeonhole (n m : nat) :
    m < n ->
    (forall i, i < n -> f i < m) ->
    exists i1, exists i2, i1 < i2 /\ i2 < n /\ f i1 = f i2.
  Proof.
    move=> Hmn Hf. case Hfind: (find_same [::] n) => [found used].
    case: found Hfind => Hfind.
    - exact: (find_same_exists Hfind).
    - apply: False_ind. exact: (find_same_failed Hmn Hf Hfind).
  Qed.

End Pigeonhole.


Require Export List.
Require Export ListSet.
Require Export Coq.Init.Nat.
Require Export Coq.Bool.Bool.
Require Export Coq.Logic.Classical.

Notation "[ ]" := nil (format "[ ]") : list_scope.
Notation "[ x ]" := (cons x nil) : list_scope.
Notation "[ x ; y ; .. ; z ]" := (cons x (cons y .. (cons z nil) ..)) : list_scope.

(***************************************************************************)
(* Chapter 0. LIBRARY LEMMAS AND DEFINITIONS                               *)
(***************************************************************************)
(***************************************************************************)
(* Coq库的补充和扩展。                                                        *)
(***************************************************************************)
Definition nat_eq_dec : forall x y: nat, {x = y} + {x <> y}.
  induction x as [|n Hn]; destruct y as [| m].
  - left; reflexivity.
  - right. discriminate.
  - right. discriminate.
  - destruct (Hn m) as [e | d].
    + left; apply f_equal; exact e.
    + right. intro e. apply d. injection e. trivial.
Defined.

(***************************************************************************)
(* Chapter 1. BASIC DEFINITIONS AND PROPERTIES                             *)
(***************************************************************************)
(***************************************************************************)
(* Basic Paxos涉及对象的抽象类型定义，并证明相关定理。                             *)
(***************************************************************************)
Inductive priest : Type :=
  | priestId : nat -> priest.

Inductive decree : Type :=
  | decreeId : nat -> decree.

Inductive number : Type :=
  | numberId : nat -> number.

Definition priest_eq_dec : forall x y:priest, {x = y} + {x <> y}.
  intros [n] [m]. destruct (nat_eq_dec n m) as [e | d].
  - left. apply f_equal. exact e.
  - right. intro e. apply d. injection e; trivial.
Defined.

Definition beq_priest (x1 x2 : priest) :=
  match x1, x2 with
  | priestId n1, priestId n2 => Nat.eqb n1 n2
  end.

Definition beq_decree (x1 x2 : decree) :=
  match x1, x2 with
  | decreeId n1, decreeId n2 => Nat.eqb n1 n2
  end.

Definition blt_decree (x1 x2 : decree) :=
  match x1, x2 with
  | decreeId n1, decreeId n2 => ltb n1 n2
  end.

Theorem beq_decree_true : forall d1 d2 : decree,
  beq_decree d1 d2 = true -> d1 = d2.
Proof.
  intros d1. destruct d1 as [n1]. intros d2. destruct d2 as [n2].
  revert n2. induction n1 as [ | n1 IHn1]; intro n2.
  - simpl. destruct n2 as [| n2].
    + intros e. reflexivity.
    + intros e. discriminate e.
  - simpl. destruct n2 as [| n2].
    + intros e. discriminate.
    + intros e. simpl in IHn1. apply IHn1 in e.
      repeat f_equal. injection e. trivial.
Qed.

Theorem beq_decree_refl : forall d : decree,
  true = beq_decree d d.
Proof.
  intros d. destruct d. induction n.
  - reflexivity.
  - rewrite IHn. simpl. reflexivity.
Qed.

Theorem beq_decree_true_iff : forall d1 d2 : decree,
  beq_decree d1 d2 = true <-> d1 = d2.
Proof.
  split.
  - apply beq_decree_true.
  - intros. rewrite H. symmetry. apply beq_decree_refl.
Qed.

Definition beq_number (x1 x2 : number) :=
  match x1, x2 with
  | numberId n1, numberId n2 => Nat.eqb n1 n2
  end.

Definition blt_number (x1 x2 : number) :=
  match x1, x2 with
  | numberId n1, numberId n2 => ltb n1 n2
  end.

Definition less_or_equal_number (x1 x2 : number) :=
  beq_number x1 x2 = true /\ blt_number x1 x2 = true.

Theorem beq_number_true : forall n1 n2 : number,
  beq_number n1 n2 = true -> n1 = n2.
Proof.
  intros n1. destruct n1 as [nat1]. intros n2. destruct n2 as [nat2].
  revert nat2. induction nat1 as [ | nat1 IHn1]; intros nat2.
  - simpl. destruct nat2 as [ | nat2].
    + intros e. reflexivity.
    + intros e. discriminate e.
  - simpl. destruct nat2 as [| nat2].
    + intros e. discriminate.
    + intros e. simpl in IHn1. apply IHn1 in e.
      repeat f_equal. injection e. trivial.
Qed.

Theorem beq_number_refl : forall num : number,
  true = beq_number num num.
Proof.
  intros num. destruct num. induction n.
  - reflexivity.
  - rewrite IHn. simpl. reflexivity.
Qed.

Theorem beq_number_true_iff : forall n1 n2 : number,
  beq_number n1 n2 = true <-> n1 = n2.
Proof.
  split.
  - apply beq_number_true.
  - intros. rewrite H. symmetry. apply beq_number_refl.
Qed.

(***************************************************************************)
(* Chapter 2. A COMPLEMENT TO THE PROPERTIES OF PRIEST SETS                *)
(***************************************************************************)
(***************************************************************************)
(* 补充priest集合的定义和性质。                                                 *)
(***************************************************************************)
(* 此处的相等是两个priest集合的无序相等性质。 *)
Axiom Axiom_Set : forall x y : set priest,
  x = y <-> (forall z, In z x <-> In z y).

Lemma Axiom_infer1 : forall x y : set priest,
  x <> y <-> ~(forall z, In z x <-> In z y).
Proof.
  intros. apply not_iff_compat. apply Axiom_Set.
Qed.

Lemma Axiom_infer2 : forall x y : set priest,
  ~(forall z, In z x <-> In z y) -> (exists a, In a x /\ ~In a y) \/ (exists a, In a y /\ ~In a x).
Proof.
  intros x y H. apply not_all_ex_not in H. destruct H as [n H]. unfold iff in H. apply not_and_or in H. destruct H.
  - apply imply_to_and in H. left. exists n. apply H.
  - apply imply_to_and in H. right. exists n. apply H.
Qed.

Definition subset (u v : set priest) := forall a, set_In a u -> set_In a v.

Inductive nincl (u v : set priest) : Prop :=
  nincl_cons : forall a, In a u -> ~ In a v -> nincl u v.

Definition sincl (u v : set priest) := subset u v /\ (exists a, In a v /\ ~In a u).

Lemma setDecR : forall u v : set priest, (exists a, In a v /\ ~In a u) -> u <> v.
Proof.
  intros u v H. destruct H as [a H]. destruct (list_eq_dec priest_eq_dec u v).
  + destruct e. destruct H as [H H1]. eauto.
  + exact n.
Qed.

Lemma setDecL : forall u v : set priest, (exists a, In a u /\ ~In a v) -> u <> v.
Proof.
  intros u v H. destruct H as [a H]. destruct (list_eq_dec priest_eq_dec u v).
  + destruct e. destruct H. eauto.
  + exact n.
Qed.

Lemma set_NotSubset : forall u v : set priest, (exists a, In a v /\ ~In a u) <-> ~ subset v u.
Proof.
  intros; split.
 - intros H1 H2. destruct H1. generalize (H2 x); intro H3. destruct H as [H H1].
   apply H3 in H. auto.
 - intro H. apply not_all_ex_not in H. destruct H. exists x. apply imply_to_and in H. auto.
Qed.

Lemma setIntuitionL : forall u v , subset u v -> sincl u v \/ u = v.
Proof.
  intros u v H. destruct (list_eq_dec priest_eq_dec u v).
  - right. apply e.
  - left. apply Axiom_infer1 in n. apply Axiom_infer2 in n. unfold sincl. split.
    + apply H.
    + unfold subset in H. destruct n as [H1 | H2].
      { destruct H1 as [a H1]. generalize (H a); intros. destruct H1 as [H1 H2]. apply H0 in H1. eauto. }
      { apply H2. }
Qed.

Lemma setIntuitionR : forall u v, sincl u v \/ u = v -> subset u v.
Proof.
  intros u v H. destruct H as [H1 | h2].
  - destruct H1 as [H1 H2]. apply H1.
  - unfold subset. intros a H. rewrite h2 in H. apply H.
Qed.

Lemma setIntuition : forall u v, sincl u v \/ u = v <-> subset u v.
Proof.
  intros. split.
  - apply setIntuitionR.
  - apply setIntuitionL.
Qed.

Lemma sincl_spec : forall u v, sincl u v -> sincl v u <-> False.
Proof.
  intros u v H. destruct H as [H1 H2]. destruct H2 as [a H2]. destruct H2 as [H2 H3]. split.
  - intro H4. destruct H4 as [H4 H5]. unfold subset in H4. generalize (H4 a). intros H.
    apply H in H2. auto.
  - intro. destruct H.
Qed.

Lemma sincl_NotEqual : forall u v, sincl u v -> ~ u = v.
Proof.
  intros u v H. destruct H as [H H1]. apply setDecR. apply H1.
Qed.

Lemma double_inclusion : forall u v, subset u v -> subset v u -> u = v.
Proof.
  intros u v H1 H2. apply setIntuition in H1. apply setIntuition in H2. destruct H1 as [H1 | H3].
  - destruct H2 as [H2 | H4]. specialize (sincl_spec u v).
    intros H. apply H in H1. apply H1 in H2.
    destruct H2. symmetry. apply H4.
  - apply H3.
Qed.

Lemma empty_spec : forall x, ~(set_In x (empty_set priest)).
Proof.
  intros. unfold empty_set. unfold not. simpl. trivial.
Qed.

Lemma empty_spec_iff : forall x, set_In x (empty_set priest) <-> False.
Proof.
  simpl; intros. split; trivial.
Qed.

Lemma empty_spec_mem : forall Q , (exists x, set_mem priest_eq_dec x Q = true) -> Q <> empty_set priest.
Proof.
  intros Q [x e]. apply set_mem_correct1 in e.
  unfold not. intros eQ. rewrite eQ in e. exact e.
Qed.

(***************************************************************************)
(* Chapter 3. BASIC DEFINITIONS AND PROPERTIES OF BALLOT                   *)
(***************************************************************************)
(***************************************************************************)
(* 投票行为的抽象和形式化定义。                                                  *)
(***************************************************************************)
(* Formally, a ballot B consisted of the following four components. *)
Record Ballot : Type := mkBallot
{
  (* Bdec A decree (the one being voted on) *)
  dec : decree;
  (* Bqrm A nonempty set of priests (the ballot's quorum) *)
  qrm : set priest;
  (* Bvot A set of priests (the ones who cast votes for the decree) *)
  vot : set priest;
  (* Bbal A ballot number *)
  bal : number;
}.

(***************************************************************************)
(* Chapter 4. BASIC DEFINITIONS AND PROPERTIES OF MESSAGE                  *)
(***************************************************************************)
(***************************************************************************)
(* 消息行为的抽象和形式化定义。                                                  *)
(***************************************************************************)
Record Message : Type := mkMessage
{
  typeM : nat;         (* 消息的类型。 *)
  balM : number;       (* 消息的轮次。 *)
  maxBalM : number;   (* 消息的轮次。只有type 2有。 *)
  maxValM : decree;     (* 消息的值。type 2表示曾经参与的最大值，type 3 4表示现阶段进行投票的值，type 1没有。 *)
  accM : priest;       (* 消息的发送者。type 2 4时有，其他的没有。 *)
}.

(***************************************************************************)
(* Chapter 5. DEFINITIONS OF SYSTEM STATES                                 *)
(***************************************************************************)
(***************************************************************************)
(* 系统状态定义。                                                             *)
(***************************************************************************)
(* 系统所有轮次编号的集合。 *)
Variables Numbers : list number.
(* 系统所有参与者的集合。 *)
Variables Acceptors : set priest.
(* 系统所有待选值的集合，初始为None。 *)
Variables Values : set decree.
Variables None : decree.
(* 系统所有投票的集合。 *)
Variables aBallots : set Ballot.
(* 系统所有轮次参与者集合的集合（议会系统）。 *)
Variables Quorums : set (set priest).
(* 系统所有消息的集合。 *)
Variables msgsChannel : set Message.

(* 每个参与者Promise的最大轮次编号。 *)
Variables PromiseMaxBal : priest -> number.
(* THE WAY TO STATE CONDITION B3。 *)
(* 每个参与者Accepted的最大轮次编号和最大特定值。 *)
Variables AcceptedMaxBal : priest -> number.
Variables AcceptedMaxVal : priest -> decree.

Definition None_fact : Prop := ~In None Values.

(***************************************************************************)
(* Chapter 6. BASIC DEFINITIONS PROPERTIES OF BALLOT AND MESSAGE           *)
(***************************************************************************)
(***************************************************************************)
(* Ballot和Message基本性质的定义和证明。                                        *)
(***************************************************************************)
Lemma characteristic_prop_Ballot : forall b1 b2,  In b1 aBallots -> In b2 aBallots -> (dec b1) = (dec b2)
                             /\(qrm b1) = (qrm b2)
                             /\(vot b1) = (vot b2)
                             /\(bal b1) = (bal b2) <-> b1 = b2.
Proof.
  intros b1 b2 i1 i2. split.
  - destruct b1; destruct b2. simpl. intuition. subst. reflexivity.
  - intro e. subst. auto.
Qed.

Lemma characteristic_prop_Message : forall m1 m2,  In m1 msgsChannel -> In m2 msgsChannel -> (typeM m1) = (typeM m2)
                             /\(balM m1) = (balM m2)
                             /\(maxValM m1) = (maxValM m2)
                             /\(maxBalM m1) = (maxBalM m2)
                             /\(accM m1) = (accM m2) <-> m1 = m2.
Proof.
  intros m1 m2 i1 i2. split.
  - destruct m1; destruct m2. simpl. intuition. subst. reflexivity.
  - intro e. subst. auto.
Qed.

(***************************************************************************)
(* Chapter 7. DEFINITIONS OF PAXOS CONDITIONS AND THESE LEMMAS             *)
(***************************************************************************)
(***************************************************************************)
(* Paxos三大条件以及引理的定义和证明。                                           *)
(***************************************************************************)
(* CONDITION B1 *)
Hypothesis Unique_Ballot : forall x y : Ballot,
  In x aBallots -> In y aBallots -> x = y <-> (bal x) = (bal y).

Hypothesis eq_dec_Ballot : forall x y : Ballot,
  {(bal x) = (bal y)} + {blt_number (bal x) (bal y) = true}.

(* CONDITION B2。 *)
Hypothesis QuorumsAssumption: forall Q1 Q2 : set priest, In Q1 Quorums /\ In Q2 Quorums ->
  exists q, set_In q (set_inter priest_eq_dec Q1 Q2).

Lemma QuorumNonEmptyAuxiliary : forall Q1 Q2, In Q1 Quorums /\ In Q2 Quorums ->
  Q1 <> empty_set priest /\ Q2 <> empty_set priest.
Proof.
  intros Q1 Q2 HQ1Q2. apply QuorumsAssumption in HQ1Q2. destruct HQ1Q2 as [q Hq].
  apply set_inter_elim in Hq. destruct Hq as [Hq1 Hq2]. split.
  - apply empty_spec_mem. exists q.
    apply set_mem_correct2. apply Hq1.
  - apply empty_spec_mem. exists q.
    apply set_mem_correct2. apply Hq2.
Qed.

Lemma QuorumNonEmpty : forall Q, In Q Quorums -> Q <> empty_set priest.
Proof.
  intros Q H. specialize (QuorumNonEmptyAuxiliary Q Q); intros HQ.
  assert (HD : forall Q, In Q Quorums -> In Q Quorums /\ In Q Quorums ).
    { intros AQ AH. split.
      + exact AH.
      + exact AH. }
  specialize (HD Q); intros.
  apply HD in H. apply HQ in H.
  destruct H as [H1 H2]. apply H1.
Qed.

(***************************************************************************)
(* Chapter 8. DEFINITIONS ABOUT HOW A VALUE IS CHOSEN                      *)
(***************************************************************************)
(***************************************************************************)
(* 特定值被选择的定义，即公式（2）。                                              *)
(***************************************************************************)
Inductive VotedForIn : priest -> decree -> number -> Prop :=
  | cons_VotedForIn : forall a v b, In a Acceptors -> In v Values -> In b Numbers ->
    (exists m, In m msgsChannel /\ (typeM m) = 4
                                /\ (balM m) = b
                                /\ (maxValM m) = v
                                /\ (accM m) = a) -> VotedForIn a v b.

Inductive SuccessfulIn : decree -> number -> Prop :=
  | cons_SuccessfulIn : forall v b, In v Values -> In b Numbers -> (exists Q, In Q Quorums ->
      forall a, set_In a Q -> VotedForIn a v b) -> SuccessfulIn v b.

Inductive Chosen : decree -> Prop :=
  | cons_Chosen : forall v, In v Values -> (exists b, In b Numbers ->
      SuccessfulIn v b) -> Chosen v.

(***************************************************************************)
(* Chapter 9. DEFINITIONS OF BALLOT RELIABILITY AND NONTAMPERABILITY       *)
(***************************************************************************)
(***************************************************************************)
(* 每个投票轮次的真实性和不可篡改性的定义。                                         *)
(***************************************************************************)
Inductive trivial_qrm : Ballot -> Prop :=
  | trivial_qrm_cons : forall b, set_In b aBallots -> set_In (qrm b) Quorums -> trivial_qrm b.

Inductive trivial_decree : Ballot -> Prop :=
  | trivial_decree_cons : forall b, set_In b aBallots -> set_In (dec b) Values -> trivial_decree b.

Inductive trivial_number : Ballot -> Prop :=
  | trivial_number_cons : forall b, set_In b aBallots -> set_In (bal b) Numbers -> trivial_number b.

Inductive trivial_qrm_vot : Ballot -> Prop :=
  | ttrivial_qrm_vot_cons : forall b, set_In b aBallots -> subset (vot b) (qrm b) -> trivial_qrm_vot b.

Inductive trivial_vot_msg : Ballot -> Prop :=
  | trivial_vot_msg_cons : forall b a, In b aBallots -> set_In a (vot b) ->
      (exists m, In m msgsChannel -> (typeM m) = 4
                                  /\ (balM m) = (bal b)
                                  /\ (maxValM m) = (dec b)
                                  /\ (accM m) = a) -> trivial_vot_msg b.

Inductive trivial_vot : Ballot -> Prop :=
  | trivial_vot_cons : forall b, In b aBallots -> (forall a, set_In a (vot b) ->
      VotedForIn a (dec b) (bal b)) -> trivial_vot b.

Inductive trivial_qrm_Acce : Ballot -> Prop :=
  | trivial_qrm_Acce_cons : forall b, set_In b aBallots ->
      (forall a, set_In a (qrm b) -> set_In a Acceptors) -> trivial_qrm_Acce b.

Inductive trivial (b : Ballot) : Prop :=
  | ttrivial_cons : trivial_qrm b -> trivial_decree b -> trivial_number b -> trivial_qrm_vot b
      -> trivial_qrm_Acce b -> trivial_vot b -> trivial_vot_msg b -> trivial b.

(***************************************************************************)
(* Chapter 10. DEFINITIONS AND PROPERTIES OF SYSTEM VOTES STATE            *)
(***************************************************************************)
(***************************************************************************)
(* 系统投票状态的定义。                                                        *)
(***************************************************************************)
(* 参与者没有在某一轮次投票，并且以后也不会在这一轮次投票。 *)
Inductive WontVoteIn : priest -> number -> Prop :=
  | cons_WontVoteIn : forall a b, In a Acceptors -> In b Numbers ->
         (forall v, In v Values -> ~ VotedForIn a v b)
      /\ blt_number b (PromiseMaxBal a) = true -> WontVoteIn a b.

(* 在任何轮次编号小与b的投票轮次中，除了v以外，没有别的特定值被选择，或者永远不会被选择，称为在（b, v）投票轮次稳定。 *)
Inductive SafeAt : decree -> number -> Prop :=
  | cons_SafeAt : forall v b, In v Values -> In b Numbers ->
      (forall c, In c Numbers -> blt_number c b = true ->
        (
          (exists Q,
              (forall ballot, trivial ballot -> In ballot aBallots -> (c = (bal ballot)) ->
                  Q = (qrm ballot) /\ (forall a, In a Q -> VotedForIn a v c \/ WontVoteIn a c)
              )
          )
        )
      )
       -> SafeAt v b.

(***************************************************************************)
(* Chapter 11. DEFINITIONS OF PAXOS ALL PHASES                             *)
(***************************************************************************)
(***************************************************************************)
(* Paxos四个阶段的定义，分别对应系统中产生四条消息。                                *)
(***************************************************************************)
Inductive MsgInv : Prop :=
  | cons_MsgInv : (forall m, In m msgsChannel ->
        ((typeM m) = 1 -> True)
     /\ ((typeM m) = 2 -> less_or_equal_number (balM m) (PromiseMaxBal(accM m))
                      /\    (In (maxValM m) Values /\
                             In (maxBalM m) Numbers /\
                             VotedForIn (accM m) (maxValM m) (maxBalM m)
                         \/ ((maxValM m) = None /\
                             (maxBalM m) = numberId 0)))
     /\((typeM m) = 3 -> (SafeAt (maxValM m) (balM m)
                      /\ forall ma, set_In ma msgsChannel -> (typeM ma) = 3 ->
                            (balM ma) = (balM m) -> ma = m))
     /\((typeM m) = 4 -> (less_or_equal_number (balM m) (AcceptedMaxBal (accM m))
                      /\ exists ma, set_In ma msgsChannel
                                 /\ (typeM ma) = 3
                                 /\ (balM ma) = (balM m)
                                 /\ (maxValM ma) = (maxValM m)))) -> MsgInv.

(***************************************************************************)
(* Chapter 12. VERIFICATION OF BASIC PAXOS                                 *)
(***************************************************************************)
(***************************************************************************)
(* Basic Paxos算法的验证。                                                    *)
(***************************************************************************)
Lemma equalQrmVot : forall b, trivial_qrm_vot b -> subset (qrm b) (vot b) -> (qrm b) = (vot b).
Proof.
  intros b H1 H2. destruct H1 as [b H1 H3]. apply double_inclusion.
  - exact H2.
  - exact H3.
Qed.

Lemma QrmVotToSucc :
  forall b a, trivial b -> set_In b aBallots ->
  set_In a (qrm b) -> (qrm b) = (vot b) -> Chosen (dec b).
Proof.
  intros b a H H0 H1 H2.
  destruct H as [H3 H4 H5 H6 H7 H8 H9]. apply cons_Chosen.
  - destruct H4 as [b H H4]. exact H4.
  - destruct H8 as [b H8 H10]. generalize (H10 a ); intros H11.
    rewrite H2 in H1. apply H11 in H1.
    destruct H1 as [ a v b0 H H1 H12 H13]. exists b0. intros H15.
    apply (cons_SuccessfulIn v b0).
    + exact H1.
    + exact H15.
    + exists (qrm b). intros. generalize (H10 a0); intros.
      rewrite H2 in H16. apply H17 in H16. apply H16.
Qed.

Lemma SuccToEqual : forall b1 b2, trivial b1 -> trivial b2 -> subset (qrm b1) (vot b1) -> subset (qrm b2) (vot b2)
  -> (qrm b1) = (vot b1) /\ (qrm b2) = (vot b2).
Proof.
  intros b1 b2 H H0 H1 H2. destruct H as [H H3 H4 H5 H6 H7 H8].
  destruct H0 as [H0 H9 H10 H11 H12 H13 H14]. split.
  - apply equalQrmVot.
    + apply H5.
    + apply H1.
  - apply equalQrmVot.
    + apply H11.
    + exact H2.
Qed.

Lemma SuccToChosen : forall b a, trivial b -> set_In b aBallots -> set_In a (qrm b) -> subset (qrm b) (vot b) ->
  Chosen (dec b).
Proof.
  intros b a H H0 H1 H2. apply (QrmVotToSucc b a).
  - apply H.
  - apply H0.
  - apply H1.
  - apply equalQrmVot.
    + destruct H as [H H3 H4 H5 H6 H7 H8]. apply H5.
    + apply H2.
Qed.

Lemma SuccToVoted : forall a b, trivial b -> subset (qrm b) (vot b) ->
  set_In a (qrm b) -> VotedForIn a (dec b) (bal b).
Proof.
  intros a b H H0 H1. destruct H as [H H2 H3 H4 H5 H6 H7].
  destruct H6 as [b H6 H8].
  generalize (H8 a); intros H9.
  generalize (equalQrmVot b); intros H10.
  apply H10 in H4.
  - rewrite H4 in H1. apply H9 in H1.
    apply H1.
  - exact H0.
Qed.

Lemma VotedInv :
  forall a v b, MsgInv -> In a Acceptors /\ In v Values /\ In b Numbers ->
                VotedForIn a v b -> less_or_equal_number b (AcceptedMaxBal a) /\ SafeAt v b.
Proof.
  intros a v b H H0 H1. destruct H. destruct H1 as [a v b H1 H2 H3 H4].
  destruct H4 as [x H4]. generalize (H x); intros H5.
  destruct H4 as [H4 H6]. apply H5 in H4. destruct H4 as [H4 H7].
  destruct H7 as [H7 H8]. destruct H8 as [H8 H9]. destruct H6 as [H6 H10].
  apply H9 in H6. destruct H6 as [H6 H11]. destruct H10 as [H10 H12].
  destruct H12 as [H12 H13]. split.
  - rewrite <- H10. rewrite <- H13. apply H6.
  - destruct H11 as [ma H11]. generalize (H ma); intros H14.
    destruct H11 as [H11 H15]. apply H14 in H11. destruct H11 as [H11 H16].
    destruct H16 as [H16 H17]. destruct H17 as [H17 H18].
    destruct H15 as [H15 H19]. apply H17 in H15. destruct H15 as [H15 H20].
    destruct H19 as [H19 H21]. rewrite <- H12. rewrite <- H10.
    rewrite <- H19. rewrite <- H21. apply H15.
Qed.

Lemma VotedInvForLe :
  forall a v b, MsgInv -> In a Acceptors /\ In v Values /\ In b Numbers ->
                VotedForIn a v b -> less_or_equal_number b (AcceptedMaxBal a).
Proof.
  intros a v b H H0 H1. destruct H. destruct H1 as [a v b H1 H2 H3 H4].
  destruct H4 as [m H4]. specialize (H m); intros.
  destruct H4 as [H4 H5]. apply H in H4.
  destruct H4 as [H4 H6]. destruct H6 as [H6 H7].
  destruct H7 as [H7 H8]. destruct H5 as [H5 H9].
  apply H8 in H5. destruct H9 as [H9 H10].
  destruct H10 as [H10 H11]. destruct H5 as [H5 H12].
  rewrite <- H9. rewrite <- H11. apply H5.
Qed.

Lemma VotedInvForSafeAt :
  forall a v b, MsgInv -> In a Acceptors /\ In v Values /\ In b Numbers ->
                VotedForIn a v b -> SafeAt v b.
Proof.
  intros a v b H H0 H1. destruct H. destruct H1 as [a v b H1 H2 H3 H4].
  destruct H4 as [m H4]. generalize (H m); intros H5.
  destruct H4 as [H4 H6]. apply H5 in H4.
  destruct H4 as [H4 H7]. destruct H7 as [H7 H8].
  destruct H8 as [H8 H9]. destruct H6 as [H6 H10].
  apply H9 in H6. destruct H6 as [H6 H11].
  destruct H10 as [H10 H12]. destruct H12 as [H12 H13].
  destruct H11 as [ma H11]. destruct H11 as [H11 H14].
  specialize (H ma); intros. apply H in H11.
  destruct H11 as [H11 H15]. destruct H15 as [H15 H16].
  destruct H16 as [H16 H17]. destruct H14 as [H14 H18].
  apply H16 in H14. destruct H14 as [H14 H19].
  rewrite <- H12. rewrite <- H10.
  destruct H18 as [H18 H20].
  rewrite <- H18. rewrite <- H20. exact H14.
Qed.

Lemma VotedOnce :
  forall a1 a2 b v1 v2, MsgInv -> In a1 Acceptors ->
  In a2 Acceptors -> In b Numbers -> In v1 Values -> In v2 Values ->
  VotedForIn a1 v1 b /\ VotedForIn a2 v2 b -> (v1 = v2).
Proof.
  intros a1 a2 b v1 v2 H H0 H1 H2 H3 H4 H5.
  destruct H5 as [H5 H6]. destruct H.
  destruct H5 as [a1 v1 b H5 H7 H8 H9].
  destruct H6 as [a2 v2 b H6 H10 H11 H12].
  destruct H9 as [m1 H9].
  destruct H12 as [m2 H12].
  generalize (H m1); intros H13.
  generalize (H m2); intros H14.
  destruct H9 as [H9 H15]. destruct H15 as [H15 H16].
  destruct H16 as [H16 H17]. destruct H17 as [H17 H18].
  destruct H12 as [H12 H19]. destruct H19 as [H19 H20].
  destruct H20 as [H20 H21]. destruct H21 as [H21 H22].
  apply H13 in H9. apply H14 in H12.
  destruct H9 as [H9 H23]. destruct H23 as [H23 H24].
  destruct H24 as [H24 H25]. destruct H12 as [H12 H26].
  destruct H26 as [H26 H27]. destruct H27 as [H27 H28].
  apply H25 in H15. apply H28 in H19.
  destruct H15 as [H15 H29]. destruct H19 as [H19 H30].
  destruct H29 as [m3 H29]. destruct H30 as [m4 H30].
  destruct H29 as [H29 H31]. destruct H31 as [H31 H32].
  destruct H32 as [H32 H33]. destruct H30 as [H30 H34].
  destruct H34 as [H34 H35]. destruct H35 as [H35 H36].
  generalize (H m3); intros H37.
  generalize (H m4); intros H38.
  assert ( H29Copy := H29 ). apply H37 in H29.
  assert ( H30Copy := H30 ). apply H38 in H30.
  destruct H29 as [H29 H39]. destruct H39 as [H39 H40].
  destruct H40 as [H40 H41]. destruct H30 as [H30 H42].
  destruct H42 as [H42 H43]. destruct H43 as [H43 H44].
  assert ( H31Copy := H31 ).
  assert ( H34Copy := H34 ).
  apply H40 in H31. apply H43 in H34.
  destruct H31 as [H31 H45]. destruct H34 as [H34 H46].
  generalize (H45 m4); intros H47.
  assert ( H30CopyTwo := H30Copy ). apply H47 in H30Copy.
  - apply characteristic_prop_Message in H30Copy.
    + destruct H30Copy as [H48 H49].
      destruct H49 as [H49 H50].
      destruct H50 as [H50 H51].
      destruct H51 as [H51 H52].
      rewrite <- H21. rewrite <- H17.
      rewrite <- H36. rewrite <- H33.
      symmetry. exact H50.
    + exact H30CopyTwo.
    + exact H29Copy.
  - exact H34Copy.
  - rewrite H35. rewrite H32.
    rewrite H16. rewrite H20.
    auto.
Qed.

Lemma SuccToSafeAt : forall b a, MsgInv -> trivial b -> In a (qrm b) ->
  subset (qrm b) (vot b) -> SafeAt (dec b) (bal b).
Proof.
  intros b a H H0 H1 H2. assert ( HCopy := H ).
  destruct H. assert ( H0Copy := H0 ).
  destruct H0 as [H3 H4 H5 H6 H7 H8 H9].
  destruct H7 as [b H7 H10].
  specialize (H10 a); intros.
  apply (VotedInvForSafeAt a).
  - apply HCopy.
  - split.
    + apply H10 in H1. exact H1.
    + split.
      { destruct H4 as [b H4 H11]. exact H11. }
      { destruct H5 as [b H5 H12]. exact H12. }
  - apply SuccToVoted.
    + apply H0Copy.
    + apply H2.
    + apply H1.
Qed.

Lemma SafeAtToVote : forall b1 b2, blt_number (bal b1) (bal b2)=true -> trivial b2 -> trivial b1 ->
  SafeAt (dec b2) (bal b2) ->
  (exists a, In a (qrm b1) /\ In a (qrm b2) /\ (VotedForIn a (dec b2) (bal b1) \/ WontVoteIn a (bal b1))).
Proof.
  intros b1 b2 H H0 H1 H2.
  generalize (QuorumsAssumption (qrm b1) (qrm b2)); intros H3.
  assert ( H0Copy := H0 ). assert ( H1Copy := H1 ).
  destruct H0 as [H4 H5 H6 H7 H8 H9 H10].
  destruct H1 as [H11 H12 H13 H14 H15 H16 H17].
  assert (HD : forall Q1 Q2, In Q1 Quorums -> In Q2 Quorums -> In Q1 Quorums /\ In Q2 Quorums ).
    { intros Q1 Q2 HQ1 HQ2. split.
      + exact HQ1.
      + exact HQ2. }
  specialize (HD (qrm b1) (qrm b2)); intros.
  destruct H4 as [b2 H4 H19].
  destruct H11 as [b1 H11 H20].
  apply HD in H20. apply H3 in H20.
  destruct H20 as [q H20].
  - exists q. destruct H2 as [v n H2 H21 H22]. split.
    + apply set_inter_elim1 in H20. exact H20.
    + split.
      { apply set_inter_elim2 in H20. exact H20. }
      { specialize (H22 (bal b1)); intros.
        destruct H13 as [b1 H13 H23].
        apply H22 in H23. destruct H23 as [Q H23].
        specialize (H23 b1); intros.
        apply H23 in H1Copy. destruct H1Copy as [H1Copy H24].
        specialize (H24 q); intros. apply set_inter_elim1 in H20.
        rewrite H1Copy in H24. apply H24 in H20.
        - exact H20.
        - exact H13.
        - auto.
        - exact H. }
  - apply H19.
Qed.

Lemma SafeAtToCons : forall b1 b2 a,
  MsgInv -> trivial b1 -> trivial b2 -> In a (qrm b1) -> In a (qrm b2) ->
  (VotedForIn a (dec b2) (bal b1) \/ WontVoteIn a (bal b1)) ->
  VotedForIn a (dec b1) (bal b1) -> (dec b1) = (dec b2).
Proof.
  intros b1 b2 a H H0 H1 H2 H3 H4 H5.
  destruct H0 as [H6 H7 H8 H9 H10 H11 H12].
  destruct H1 as [H13 H14 H15 H16 H17 H18 H19].
  destruct H4 as [H4Left | H4Right].
  - apply (VotedOnce a a (bal b1) (dec b1) (dec b2)).
    + exact H.
    + destruct H10 as [b1 H10 H20].
      specialize (H20 a); intros.
      apply H20 in H2. exact H2.
    + destruct H10 as [b1 H10 H20].
      specialize (H20 a); intros.
      apply H20 in H2. exact H2.
    + destruct H8 as [b1 H8 H20].
      exact H20.
    + destruct H7 as [b1 H7 H20].
      exact H20.
    + destruct H14 as [b2 H14 H20].
      exact H20.
    + split.
      { apply H5. }
      { apply H4Left. }
  - destruct H4Right as [a n H4Right1 H4Right2 H4Right3].
    destruct H4Right3 as [H4Right3 H4Right4].
    specialize (H4Right3 (dec b1)); intros.
    destruct H7 as [b1 H7 H20].
    apply H4Right3 in H20. unfold not in H20.
    apply H20 in H5. destruct H5.
Qed.

Lemma ConsistentOfNotEqual : forall b1 b2, MsgInv ->
  trivial b1 -> trivial b2 -> subset (qrm b1) (vot b1) -> subset (qrm b2) (vot b2) ->
  blt_number (bal b1) (bal b2)=true -> (dec b1) = (dec b2).
Proof.
  intros b1 b2 H H0 H1 H2 H3 H4.
  generalize (SafeAtToVote b1 b2); intros H5.
  apply H5 in H4. destruct H4 as [x H4].
  destruct H4 as [H4 H6]. destruct H6 as [H6 H7].
  apply (SafeAtToCons b1 b2 x).
  - apply H.
  - apply H0.
  - apply H1.
  - exact H4.
  - exact H6.
  - exact H7.
  - generalize (SuccToVoted x b1); intros H8.
    apply H8 in H0.
    + apply H0.
    + apply H2.
    + apply H4.
  - apply H1.
  - apply H0.
  - assert ( H1Copy := H1 ). destruct H1 as [H1 H6 H7 H8 H9 H10 H11].
    destruct H11 as [b2 a H11 H12 H13].
    generalize (SuccToSafeAt b2 a); intros H14.
    apply H14 in H.
    + exact H.
    + exact H1Copy.
    + generalize (SuccToEqual b1 b2); intros H15.
      apply H15 in H0.
      { destruct H0 as [H0 H16].
        rewrite H16. exact H12. }
      { exact H1Copy. }
      { exact H2. }
      { exact H3. }
    + exact H3.
Qed.

Lemma ConsistentOfEqual : forall b1 b2, trivial b1 -> trivial b2 ->
  subset (qrm b1) (vot b1) -> subset (qrm b2) (vot b2) ->
  (bal b1) = (bal b2) -> (dec b1) = (dec b2).
Proof.
  intros b1 b2 H H0 H1 H2 H3.
  apply (characteristic_prop_Ballot b1 b2).
  - destruct H as[H11 H12 H13 H14 H15 H16 H17].
    destruct H11 as [b1 H11 H18]. exact H11.
  - destruct H0 as[H4 H5 H6 H7 H8 H9 H10].
    destruct H4 as [b2 H4 H19]. exact H4.
  - apply (Unique_Ballot b1 b2).
    + destruct H as[H11 H12 H13 H14 H15 H16 H17].
      destruct H11 as [b1 H11 H18]. exact H11.
    + destruct H0 as[H4 H5 H6 H7 H8 H9 H10].
      destruct H4 as [b2 H4 H19]. exact H4.
    + exact H3.
Qed.

(***************************************************************************)
(* 共识性定理证明。                                                            *)
(***************************************************************************)
(***************************************************************************)
(* Consistent                                                           *)
(***************************************************************************)
Theorem Consistent : forall b1 b2, MsgInv ->
  trivial b1 -> trivial b2 -> subset (qrm b1) (vot b1) -> subset (qrm b2) (vot b2) ->
  (dec b1) = (dec b2).
Proof.
  intros b1 b2 H H0 H1 H2 H3.
  destruct (eq_dec_Ballot b1 b2).
  - apply (ConsistentOfEqual b1 b2).
    + apply H0.
    + apply H1.
    + apply H2.
    + apply H3.
    + apply e.
  - apply (ConsistentOfNotEqual b1 b2).
    + exact H.
    + exact H0.
    + exact H1.
    + exact H2.
    + exact H3.
    + exact e.
Qed.

(***************************************************************************)
(* Chapter 13. A CONCRETE EXAMPLE                                          *)
(***************************************************************************)
(***************************************************************************)
(* Lamport论文中的具体例子。                                                   *)
(***************************************************************************)
(*具体例子对单个投票的抽象。*)
Record Vote : Type := mkVote
{
  (* A priest *)
  Vpriest : priest;
  (* A ballot number *)
  Vbal : number;
  (* A decree *)
  Vdec : decree;
}.

(* 系统中共有五个参与者，组成acceptors。涉及到两个特定值以及五个轮次的投票行为。*)
Definition accPA := priestId 1.
Definition accPB := priestId 2.
Definition accPC := priestId 3.
Definition accPD := priestId 4.
Definition accPE := priestId 5.

Definition acceptors := [accPA; accPB; accPC; accPD; accPE].

Definition valueA := decreeId 1.
Definition valueB := decreeId 2.

Definition number2 := numberId 2.
Definition number5 := numberId 5.
Definition number14 := numberId 14.
Definition number27 := numberId 27.
Definition number29 := numberId 29.

Definition ballot_2 := mkBallot valueA [accPA; accPB; accPC; accPD] [accPD] number2.
Definition ballot_5 := mkBallot valueB [accPA; accPB; accPC; accPE] [accPC] number5.
Definition ballot_14 := mkBallot valueA [accPB; accPD; accPE] [accPB; accPE] number14.
Definition ballot_27 := mkBallot valueB [accPA; accPC; accPD] [accPA; accPC; accPD] number27.
Definition ballot_29 := mkBallot valueB [accPB; accPC; accPD] [accPB] number29.

Definition Ballots := [ballot_2; ballot_5; ballot_14; ballot_27; ballot_29].

(* 以下过程用来说明：在ballot_27轮次之后，系统选择的所有特定值都满足一致性。*)
(* get一轮投票的所有投票。 *)
Fixpoint getPriestsVotes(l : list priest)(b : Ballot) : list Vote :=
  match l with
  | [] => []
  | h :: r => mkVote h (bal b) (dec b) :: getPriestsVotes r b
  end.

Definition getBallotVotes(b : Ballot) : list Vote := getPriestsVotes (vot b) b.

(* get所有轮投票的所有投票。 *)
Fixpoint getAllVotes(l : list Ballot) : list Vote :=
  match l with
  | [] => []
  | x :: r => getBallotVotes x ++ getAllVotes r
  end.

Definition votes := getAllVotes aBallots.

(* get特定参与者一轮投票的所有投票。 *)
Fixpoint isIn (x:priest)(l:list priest) : bool :=
  match l with
  | [] => false
  | h::t => if beq_priest x h then true
            else isIn x t
  end.

Fixpoint getBallotVoteForPriest(p : priest)(b : Ballot) : Vote :=
  if isIn p (vot b) then mkVote p (bal b) (dec b)
  else mkVote p (numberId 0) None.

(* get特定参与者所有轮投票的所有投票。 *)
Fixpoint getAllVotesForPriest(p : priest)(l : list Ballot) : list Vote :=
  match l with
  | [] => []
  | h :: r => getBallotVoteForPriest p h :: getAllVotesForPriest p r
  end.

Fixpoint maxVotes (e: Vote) (l : list Vote) : Vote :=
  match l with
  | [] => e
  | x :: r => if blt_number (Vbal e) (Vbal x) then maxVotes x r else maxVotes e r
  end.

(* get每个参与者在所有轮投票中的最大投票列表。 *)
Fixpoint maxs(lp : list priest)(lv : list Ballot) : list Vote :=
  match lp with
  | [] => []
  | h :: r => maxVotes (mkVote h (numberId 0) None) (getAllVotesForPriest h lv) :: maxs r lv
  end.

(* get所有参与者在所有轮投票中的最大投票。 *)
Fixpoint MaxOfAll(e: Vote)(l : list Vote) : Vote :=
  match l with
  | [] => e
  | h :: r => if blt_number (Vbal e) (Vbal h) then MaxOfAll h r else MaxOfAll e r
  end.

(* 对以上定义的检测：通过执行可以确保定义的正确性。 *)
Compute MaxOfAll (mkVote accPA (numberId 0) None) (maxs [accPA; accPB; accPC; accPD; accPE] Ballots).
Compute maxs [accPA; accPB; accPC; accPD; accPE] Ballots.

Theorem max_A : maxVotes (mkVote accPA (numberId 0) None) (getAllVotesForPriest accPA Ballots)
    = (mkVote accPA (numberId 27) valueB).
Proof.
  simpl. reflexivity.
Qed.

Theorem max_B : maxVotes (mkVote accPB (numberId 0) None) (getAllVotesForPriest accPB Ballots)
    = (mkVote accPB (numberId 29) valueB).
Proof.
  simpl. reflexivity.
Qed.

Theorem max_C : maxVotes (mkVote accPC (numberId 0) None) (getAllVotesForPriest accPC Ballots)
    = (mkVote accPC (numberId 27) valueB).
Proof.
  simpl. reflexivity.
Qed.

Theorem max_D : maxVotes (mkVote accPD (numberId 0) None) (getAllVotesForPriest accPD Ballots)
    = (mkVote accPD (numberId 27) valueB).
Proof.
  simpl. reflexivity.
Qed.

Theorem max_E : maxVotes (mkVote accPE (numberId 0) None) (getAllVotesForPriest accPE Ballots)
    = (mkVote accPE (numberId 14) valueA).
Proof.
  simpl. reflexivity.
Qed.

Theorem max_OfAll : MaxOfAll (mkVote accPA (numberId 0) None) (maxs [accPA; accPB; accPC; accPD; accPE] Ballots)
    = (mkVote accPB (numberId 29) valueB).
Proof.
  simpl. reflexivity.
Qed.

(* 在Paxos假设满足的情况下，ballot_27轮次之后系统所选的特定值都保持一致。*)
Hypothesis conditionOfMax : forall b : Ballot, (dec b)
  = Vdec (MaxOfAll (mkVote accPA (numberId 0) None) (maxs [accPA; accPB; accPC; accPD; accPE] Ballots)).

Theorem ExampleOfConsistent : forall b : Ballot, blt_number (bal ballot_27) (bal b) = true ->
  (dec b) = dec ballot_27.
Proof.
  intros. apply (conditionOfMax b).
Qed.


(** Coq coding by choukh, Oct 2021 **)

Require Import BBST.Axiom.Meta.
Require Import BBST.Axiom.Separation.

Require BBST.Axiom.Extensionality.
Require BBST.Definition.Intersect.
Require BBST.Definition.BinaryUnion.
Require BBST.Definition.Include.
Require BBST.Definition.Emptyset.

Definition 二元交 := λ A B, {x ∊ A | x ∈ B}.
Notation "A ∩ B" := (二元交 A B) (at level 49) : 集合域.

Lemma 二元交介入 : ∀ x A B, x ∈ A → x ∈ B → x ∈ A ∩ B.
Proof. intros. now apply 分离介入. Qed.
Global Hint Resolve 二元交介入 : core.

Lemma 二元交除去 : ∀ x A B, x ∈ A ∩ B → x ∈ A ∧ x ∈ B.
Proof. intros. now apply 分离除去 in H. Qed.

Lemma 二元交外介入 : ∀ x A B, x ∉ A ∨ x ∉ B → x ∉ A ∩ B.
Proof. intros. firstorder using 二元交除去. Qed.

Lemma 二元交外除去 : ∀ x A B, x ∉ A ∩ B → x ∉ A ∨ x ∉ B.
Proof. intros. 排中 (x ∈ A); auto. Qed.

Import BBST.Axiom.Extensionality.

Lemma 二元交幂等律 : ∀ A, A ∩ A = A.
Proof. intros. 外延; auto. apply 二元交除去 in H as []; auto. Qed.

Lemma 二元交交换律 : ∀ A B, A ∩ B = B ∩ A.
Proof. intros. 外延; apply 二元交除去 in H as []; auto. Qed.

Lemma 二元交结合律 : ∀ A B C, (A ∩ B) ∩ C = A ∩ (B ∩ C).
Proof.
  intros. 外延; apply 二元交除去 in H as [].
  apply 二元交除去 in H as []; auto.
  apply 二元交除去 in H0 as []; auto.
Qed.

Import BBST.Definition.Include.

Lemma 二元交保持包含关系 : ∀ A B C, A ⊆ B → A ∩ C ⊆ B ∩ C.
Proof. intros * 包含 x Hx. apply 二元交除去 in Hx as []; auto. Qed.

Lemma 二元交拒斥父集 : ∀ A B, A ⊆ B → A ∩ B = A.
Proof. intros. 外延; auto. apply 二元交除去 in H0 as []; auto. Qed.

Lemma 二元交是其左侧的子集 : ∀ A B, A ∩ B ⊆ A.
Proof. intros * x H. apply 二元交除去 in H as []; auto. Qed.

Lemma 二元交是其右侧的子集 : ∀ A B, A ∩ B ⊆ B.
Proof. intros * x H. apply 二元交除去 in H as []; auto. Qed.

Global Hint Immediate 二元交是其左侧的子集 二元交是其右侧的子集 : core.

Import BBST.Definition.Emptyset.

(* 零元 *)
Lemma 左交空集 : ∀ A, ∅ ∩ A = ∅.
Proof. intros. apply 二元交拒斥父集. apply 空集是任意集合的子集. Qed.

Lemma 右交空集 : ∀ A, A ∩ ∅ = ∅.
Proof. intros. rewrite 二元交交换律. apply 左交空集. Qed.

(* 幺元 *)
Lemma 左交全集 : ∀ A S, A ⊆ S → S ∩ A = A.
Proof. intros. 外延; auto. now apply 二元交除去 in H0 as []. Qed.

Lemma 右交全集 : ∀ A S, A ⊆ S → A ∩ S = A.
Proof. intros. rewrite 二元交交换律. now apply 左交全集. Qed.

Import BBST.Definition.Intersect.
Import BBST.Definition.BinaryUnion.

Lemma 二元并的交等于交的二元交 : ∀ A B, 非空 A → 非空 B → ⋂ (A ∪ B) = (⋂ A) ∩ (⋂ B).
Proof with auto.
  intros. 外延.
  - apply 交集除去 in H1 as [_ H1].
    apply 二元交介入; apply 交集介入; auto.
  - apply 二元交除去 in H1 as [H1 H2]. apply 交集介入.
    + destruct H as [a Ha]. exists a; auto.
    + intros a Ha. apply 二元并除去 in Ha as [].
      * apply 交集除去 in H1 as [_ H1]; auto.
      * apply 交集除去 in H2 as [_ H2]; auto.
Qed.


Require Import GeoCoq.Axioms.parallel_postulates.
Require Import GeoCoq.Tarski_dev.Annexes.saccheri.
Require Import GeoCoq.Tarski_dev.Ch12_parallel.

Section playfair_universal_posidonius_postulate.

Context `{TnEQD:Tarski_neutral_dimensionless_with_decidable_point_equality}.

Lemma playfair__universal_posidonius_postulate : playfair_s_postulate -> universal_posidonius_postulate.
Proof.
intros HP A1 A2 A3 A4 B1 B2 B3 B4 HPar HC1 HC2 HPerp1 HC3 HC4 HPerp2.
elim HPar; intro HParS; [|destruct HParS as [HD1 [HD2 [HC5 HC6]]];
                           assert_diffs; assert_cols;
                           elim (perp_not_col2 _ _ _ _ HPerp1);
                           intro HF; exfalso; apply HF; ColR].
destruct (l8_18_existence A1 A2 B1) as [A1' [HC5 HPerp3]];
try apply par_strict_not_col_1 with B2; Par.
assert (HCong : forall A3 B3,
                  Col A1 A2 A3 -> Col B1 B2 B3 -> Perp A1 A2 A3 B3 ->
                  Cong A3 B3 A1' B1);
[|assert (HCong1 := HCong A3 B3 HC1 HC2 HPerp1);
  assert (HCong2 := HCong A4 B4 HC3 HC4 HPerp2);
  apply cong_transitivity with A1' B1; Cong].
clear HC1; clear HC2; clear HC3; clear HC4; clear HPerp1; clear HPerp2;
clear A3; clear A4; clear B3; clear B4; intros A3 B3 HC1 HC2 HPerp1;
rename HC5 into HC3; rename HPerp3 into HPerp2.
destruct (segment_construction_2 B3 A3 A1' B1) as [B3' [HC4 HCong]];
[assert_diffs; auto|]; elim (eq_dec_points A1' A3); intro HD; treat_equalities.
  {
  assert (HC1 : Col A1' B1 B3).
    apply cop_perp2__col with A1 A2; Perp.
    assert_diffs; apply col_cop__cop with B2; Col.
    apply par__coplanar, HPar.
  assert (B1 = B3); treat_equalities; Cong.
  apply l6_21 with B1 B2 A1' B1; assert_diffs; Col.
  elim (eq_dec_points A1' A1); intro HD1; treat_equalities;
  [elim (eq_dec_points A1' A2); intro HD2; [intuition|];
   apply par_strict_not_col_1 with A2;
   apply par_strict_col2_par_strict with A1' A2; Col; Par|
   apply par_strict_not_col_1 with A1;
   apply par_strict_col2_par_strict with A1 A2; Col; Par].
  }

  {
  assert (HParS' : Par_strict A1' A3 B1 B3').
    {
    apply sac__par_strict1423; split;
    [apply perp_per_1; assert_diffs; try apply perp_col0 with A1 A2; Perp|
     split; [apply perp_per_1; assert_diffs;
             try (apply perp_col0 with A3 B3; try apply perp_col0 with A1 A2);
             Perp; induction HC4; assert_cols; Col|split; Cong]].
    apply one_side_transitivity with B3.

      {
      elim (eq_dec_points B1 B3); intro HD'; treat_equalities;
      [try apply one_side_reflexivity; apply par_strict_not_col_1 in HParS;
       intro; apply HParS; assert_diffs; ColR|].
      apply l12_6; apply par_strict_col2_par_strict with B1 B2; Col.
      apply par_strict_symmetry;
      apply par_strict_col2_par_strict with A1 A2; Col; Par.
      }

      {
      rewrite (l9_19 _ _ _ _ A3); Col; [|induction HC4; assert_cols; Col].
      elim (perp_not_col2 _ _ _ _ HPerp1); intro HNC; [intuition|].
      split; [|intro; apply HNC; assert_diffs; ColR].
      split; [assert_diffs; auto|].
      split; [intro; treat_equalities; assert_diffs; intuition|auto].
      }
    }
  destruct (HP A1 A2 B1 B2 B1 B3' B1) as [_ HC5]; Col;
  [apply par_symmetry; apply par_col2_par with A1' A3;
   assert_diffs; try ColR; try apply par_strict_par; Par|].
  assert (B3 = B3'); treat_equalities; Cong.
  apply l6_21 with B1 B3' A3 B3; try apply par_strict_not_col_1 with A1'; Par;
  assert_diffs; Col; [ColR|induction HC4; assert_cols; Col].
  }
Qed.

End playfair_universal_posidonius_postulate.


Require Import Coq.Classes.Morphisms.
Require Import Coq.Classes.RelationClasses.
Require Import Logic.GeneralLogic.Base.
Require Import Logic.MinimumLogic.Syntax.
Require Import Logic.PropositionalLogic.Syntax.
Require Import Logic.ModalLogic.Syntax.
Require Import Logic.SeparationLogic.Syntax.

Local Open Scope logic_base.
Local Open Scope syntax.
Import PropositionalLanguageNotation.
Import ModalLanguageNotation.
Import SeparationLogicNotation.

Class PropositionalStable (L: Language) {minL: MinimumLanguage L} {pL: PropositionalLanguage L} (Gamma: Provable L) (stable: expr -> Prop) := {
  impp_stable: forall x y, stable x -> stable y -> stable (x --> y);
  andp_stable: forall x y, stable x -> stable y -> stable (x && y);
  orp_stable: forall x y, stable x -> stable y -> stable (x || y);
  falsep_stable: stable FF;
  stable_proper_iffp :> Proper ((fun x y => |-- x <--> y) ==> iff) stable
}.

Class ModalStable (L: Language) {minL: MinimumLanguage L} {mL: ModalLanguage L} (Gamma: Provable L) (stable: expr -> Prop) := {
  boxp_stable: forall x, stable x -> stable (boxp x)
}.

Class ModalAbsorbStable (L: Language) {minL: MinimumLanguage L} {mL: ModalLanguage L} (Gamma: Provable L) (stable: expr -> Prop) := {
  boxp_absorb_stable: forall x, stable x -> |-- x --> boxp x
}.

Class SeparationStable (L: Language) {minL: MinimumLanguage L} {sepconL: SepconLanguage L} {wandL: WandLanguage L} (Gamma: Provable L) (stable: expr -> Prop) := {
  sepcon_stable: forall x y, stable x -> stable y -> stable (x * y);
  wand_stable: forall x y, stable x -> stable y -> stable (x -* y)
}.

Class SeparationAbsorbStable (L: Language) {minL: MinimumLanguage L} {pL: PropositionalLanguage L} {sepconL: SepconLanguage L} {wandL: WandLanguage L} (Gamma: Provable L) (stable: expr -> Prop) := {
  stable_andp_sepcon1: forall x y z, stable x -> |-- (x && y) * z <--> x && (y * z)
}.

Lemma iffp_stable {L: Language} {minL: MinimumLanguage L} {pL: PropositionalLanguage L} {Gamma: Provable L} {stable: expr -> Prop} {pstable: PropositionalStable L Gamma stable}:
  forall x y, stable x -> stable y -> stable (x <--> y).
Proof.
  intros.
  apply andp_stable; apply impp_stable; auto.
Qed.

Lemma truep_stable {L: Language} {minL: MinimumLanguage L} {pL: PropositionalLanguage L} {Gamma: Provable L} {stable: expr -> Prop} {pstable: PropositionalStable L Gamma stable}:
  stable TT.
Proof.
  apply impp_stable; apply falsep_stable.
Qed.


From mathcomp Require Import all_ssreflect.
Require Import Utf8.
Import EqNotations.
Set Implicit Arguments.

Require Import basics.

(* Testing using parts of book by David Marker "Model theory: an introduction" (2002). *)

Module LanguageOfRings.
  Inductive F := plus | minus | mult | zero | one.
  Inductive R := .

  Definition L: Language F R.
  Proof.
    refine (Build_Language _ _).
    + exact (λ f, match f with
                  | plus => 2
                  | minus => 2
                  | mult => 2
                  | zero => 0
                  | one => 0
                  end).
    + intro r. destruct r.
  Defined.

  (* Test terms *)
  (* v1 * (v3 - 1) *)
  Definition t0: Term nat_eqType L.
  Proof.
    refine (function_term mult [ffun x => match nat_of_ord x with 0 => _ | _ => _ end]); clear x.
    + exact (variable _ _ 1).
    + refine (function_term minus [ffun x => match nat_of_ord x with 0 => variable _ _ 3 | _ => _ end]); clear x.
      refine (function_term one (ffun0 _)). apply card_ord.
  Defined.

  (* (v1 + v2) * (v3 + 1) *)
  Definition t1: Term nat_eqType L.
  Proof.
    refine (function_term mult [ffun x => match nat_of_ord x with 0 => _ | _ => _ end]); clear x.
    + exact (function_term plus [ffun x => match nat_of_ord x with 0 => variable _ _ 1 | _ => variable _ _ 2 end]).
    + refine (function_term plus [ffun x => match nat_of_ord x with 0 => variable _ _ 3 | _ => _ end]); clear x.
      refine (function_term one (ffun0 _)). apply card_ord.
  Defined.

  Definition t2 (n: nat): Term nat_eqType L.
  Proof.
    destruct n.
    + refine (function_term zero (ffun0 _)). apply card_ord.
    + induction n.
      - refine (function_term one (ffun0 _)). apply card_ord.
      - refine (function_term plus [ffun x => match nat_of_ord x with 0 => _ | _ => IHn end]); clear x.
        refine (function_term one (ffun0 _)). apply card_ord.
  Defined.

  (* NB! This structure isn't actually a ring. *)
  (* But still good enough to test term interpretation. *)
  Definition M: Structure L.
  Proof.
    refine (@Build_Structure _ _ L nat _ _).
    + intro f. set (ord0 (n':=1)) as ord0_2. set (Ordinal (ltac:(auto):(1<2))) as ord1_2.
      refine (match f with plus => _ | minus => _ | mult => _ | zero => _ | one => _ end); simpl.
      - intro v. exact (v ord0_2 + v ord1_2).
      - intro v. exact (v ord0_2 - v ord1_2).
      - intro v. exact (v ord0_2 * v ord1_2).
      - exact (λ _, 0).
      - exact (λ _, 1).
    + intro r. destruct r.
  Defined.

  Definition assignment: nat → nat := id.

  Eval compute in (interpreted_term M assignment t0).
  (* Error! It doesn't compute to the number 2, as it should theoretically. *)
End LanguageOfRings.

Module LanguageOfOrderedRings.
  Inductive F := plus | minus | mult | zero | one.
  Inductive R := lt.

  Definition L: Language F R.
  Proof.
    refine (Build_Language _ _).
    + exact (λ f, match f with
                  | plus => 2
                  | minus => 2
                  | mult => 2
                  | zero => 0
                  | one => 0
                  end).
    + exact (λ r, match r with lt => 2 end).
  Defined.
End LanguageOfOrderedRings.

Module LanguageOfPureSets.
  Inductive F := .
  Inductive R := .

  Definition L: Language F R.
  Proof.
    refine (Build_Language _ _).
    + intro f. destruct f.
    + intro r. destruct r.
  Defined.
End LanguageOfPureSets.

Module LanguageOfGraphs.
  Inductive F := .
  Inductive R := connected.

  Definition L: Language F R.
  Proof.
    refine (Build_Language _ _).
    + intro f. destruct f.
    + exact (λ r, match r with connected => 2 end).
  Defined.
End LanguageOfGraphs.

Module Groups.
  Inductive F := e | mult.
  Inductive R := .

  Definition L: Language F R.
  Proof.
    refine (Build_Language _ _).
    + exact (λ f, match f with e => 0 | mult => 2 end).
    + intro r. destruct r.
  Defined.

  Definition M: Structure L.
  Proof.
    refine (@Build_Structure _ _ L nat _ _).
    + intro f. refine (match f with e => _ | mult => _ end).
      - simpl. exact (λ _, 1).
      - simpl. intro v. set (ord0 (n':=1)) as n0_2.
        set (Ordinal (ltac:(auto):(1<2))) as n1_2.
        exact (v n0_2 + v n1_2).
    + intro r. destruct r.
  Defined.
End Groups.