(**************************************************************************
* TLC: A library for Coq                                                  *
* Order relations                                                         *
**************************************************************************)

Set Implicit Arguments.
From SLF (* TLC *) Require Import LibTactics LibLogic LibReflect LibOperation LibRelation.
Generalizable Variables A.

(**************************************************************************)
(* ################################################################# *)
(* * Preorder *)

(** Definition *)

Record preorder A (R:binary A) : Prop := {
   preorder_refl : refl R;
   preorder_trans : trans R }.

Arguments preorder_trans [A] [R] [p] y [x] [z].

(** Transformations *)

Lemma preorder_inverse : forall A (R:binary A),
  preorder R ->
  preorder (inverse R).
Proof using. hint trans_inverse. introv [Re Tr]. constructor~. Qed.

Lemma preorder_rclosure : forall A (R:binary A),
  preorder R ->
  preorder (rclosure R).
Proof using. hint refl_rclosure, trans_rclosure. introv [Re Tr]. constructor~. Qed.

(**************************************************************************)
(* ################################################################# *)
(* * Total preorder *)

(** Definition of total preorder relations *)

Record total_preorder A (R:binary A) : Prop := {
   total_preorder_trans : trans R;
   total_preorder_total : total R }.

Arguments total_preorder_trans [A] [R] t y [x] [z].

(** Conversion to preorder *)

Lemma total_preorder_refl : forall A (le:binary A),
  total_preorder le ->
  refl le.
Proof using. introv [Tr To]. intros x. destruct~ (To x x). Qed.

Hint Resolve total_preorder_refl.

Coercion total_preorder_to_preorder A (R:binary A)
  (O:total_preorder R) : preorder R.
Proof using. lets [M _]: O. constructor~. Qed.

Hint Resolve total_preorder_to_preorder.

(** Transformations *)

Lemma total_preorder_inverse : forall A (R:binary A),
  total_preorder R ->
  total_preorder (inverse R).
Proof using. hint trans_inverse, total_inverse. introv [Tr To]. constructor~. Qed.

Lemma total_preorder_rclosure : forall A (R:binary A),
  total_preorder R ->
  total_preorder (rclosure R).
Proof using. hint trans_rclosure, total_rclosure. introv [Re Tr]. constructor~. Qed.

(** Properties *)

Lemma inverse_of_not : forall A (R:binary A) x y,
  total R ->
  ~ R x y ->
  inverse R x y.
Proof using. introv T H. destruct (T x y); auto_false~. Qed.

Lemma inverse_strict_of_not : forall A (R:binary A) x y,
  total R ->
  ~ R x y ->
  inverse (strict R) x y.
Proof using.
  introv T H. destruct (T x y). auto_false~.
  hnf. split~. intro_subst~.
Qed.

(**************************************************************************)
(* ################################################################# *)
(* * Order *)

(** Definition *)

Record order A (R:binary A) : Prop := {
   order_refl : refl R;
   order_trans : trans R;
   order_antisym : antisym R }.

Arguments order_trans [A] [R] [o] y [x] [z].
Arguments order_antisym [A] [R] [o] [x] [y].

(** Conversion to preorder *)

Coercion order_to_preorder A (R:binary A)
  (O:order R) : preorder R.
Proof using. destruct* O. constructors*. Qed.

Hint Resolve order_to_preorder.

(** Transformations *)

Lemma order_inverse : forall A (R:binary A),
  order R ->
  order (inverse R).
Proof using.
  hint trans_inverse, antisym_inverse.
  introv [Re Tr An]. constructor~.
Qed.

Lemma order_rclosure : forall A (R:binary A),
  order R ->
  order (rclosure R).
Proof using.
  hint refl_rclosure, trans_rclosure, antisym_rclosure.
  introv [Re Tr An]. constructor~.
Qed.

(** Properties *)

(* ********************************************************************** *)
(* ################################################################# *)
(** * Order relation upto an equivalence relation *)

(** Note: this is used in LibFix *)

Record order_wrt (A:Type) (E:binary A) (R:binary A) : Prop := {
   order_wrt_refl : refl R;
   order_wrt_trans : trans R;
   order_wrt_antisym : antisym_wrt E R }.

Arguments order_wrt_trans [A] [E] [R] [o] y [x] [z].
Arguments order_wrt_antisym [A] [E] [R] [o] [x] [y].

(** Conversion to preorder *)

Coercion order_wrt_to_preorder A (E:binary A) (R:binary A)
  (O:order_wrt E R) : preorder R.
Proof using. destruct* O. constructors*. Qed.

Hint Resolve order_wrt_to_preorder.

(** Transformations *)

Lemma order_wrt_inverse : forall A (E:binary A) (R:binary A),
  order_wrt E R ->
  order_wrt E (inverse R).
Proof using.
  hint trans_inverse, antisym_wrt_inverse.
  introv [Re Tr An]. constructor~.
Qed.

Lemma order_wrt_rclosure : forall A (E:binary A) (R:binary A),
  order_wrt E R ->
  order_wrt (rclosure E) (rclosure R).
Proof using.
  hint refl_rclosure, trans_rclosure, antisym_wrt_rclosure.
  introv [Re Tr An]. constructor~.
Qed.

(** Properties *)

(**************************************************************************)
(* ################################################################# *)
(* * Total Order *)

(** Definition *)

Record total_order A (R:binary A) : Prop := {
   total_order_order :> order R;
   total_order_total : total R }.

(** Projections *)

Definition total_order_refl := order_refl.
Definition total_order_trans := order_trans.
Definition total_order_antisym := order_antisym.

Arguments total_order_trans [A] [R] [o] y [x] [z].
Arguments total_order_antisym [A] [R] [o] [x] [y].

(** Construction *)

Lemma total_order_intro : forall A (R:binary A),
   trans R ->
   antisym R ->
   total R ->
   total_order R.
Proof using.
  introv Tra Ant Tot. constructor~. constructor~.
  intros_all. destruct~ (Tot x x).
Qed.

(** Conversion to order *)

Coercion total_order_to_total_preorder A (R:binary A)
  (O:total_order R) : total_preorder R.
Proof using. destruct* O. constructors*. applys* order_trans. Qed.

Definition total_order_to_order := total_order_order.

Hint Resolve total_order_to_order total_order_to_total_preorder.

(** Transformations *)

Lemma total_order_inverse : forall A (R:binary A),
  total_order R ->
  total_order (inverse R).
Proof using.
  hint total_inverse, order_inverse.
  introv [Or To]. constructor~.
Qed.

Lemma total_order_rclosure : forall A (R:binary A),
  total_order R ->
  total_order (rclosure R).
Proof using.
  hint total_rclosure, order_rclosure.
  introv [Or To]. constructor~.
Qed.

(** Properties *)

Section TotalOrderProp.
Variables (A:Type) (R : binary A).

(** WARNING: notations here are not typeclass operators
    -- TODO: is this really what we want?
    perhaps it would be clearer to inline these notations. *)

Notation "'le'" := (R).
Notation "'ge'" := (inverse R).
Notation "'lt'" := (strict R).
Notation "'gt'" := (inverse lt).

Ltac total_order_normalize :=
  repeat rewrite rclosure_eq_fun;
  repeat rewrite inverse_eq_fun;
  repeat rewrite strict_eq_fun.

Lemma total_order_le_is_rclosure_lt : forall (To:total_order R),
  le = rclosure lt.
Proof using.
  extens. intros. total_order_normalize. iff M.
  tests~: (x = y).
  destruct M. autos*. subst*. dintuition eauto.
Qed.

Lemma total_order_lt_is_strict_le : forall (To:total_order R),
  lt = strict le.
Proof using.
  auto.
Qed.

Lemma total_order_ge_is_rclosure_gt : forall (To:total_order R),
  ge = rclosure gt.
Proof using.
  extens. intros. total_order_normalize. iff M.
  tests~: (x = y).
  destruct M. autos*. subst*. dintuition eauto.
Qed.

Lemma total_order_gt_is_strict_ge : forall (To:total_order R),
  gt = strict ge.
Proof using.
  extens. intros. total_order_normalize. iff M.
  tests~: (x = y).
  destruct M. autos*.
  destruct M. autos*.
Qed.

Lemma total_order_lt_or_eq_or_gt : forall (To:total_order R) x y,
  lt x y \/ x = y \/ gt x y.
Proof using.
  introv H. intros. total_order_normalize. tests: (x = y).
    branch~ 2.
    destruct (total_order_total H x y).
     branch~ 1.
     branch~ 3.
Qed.

Lemma total_order_lt_or_ge : forall (To:total_order R) x y,
  lt x y \/ ge x y.
Proof using.
  intros. branches (total_order_lt_or_eq_or_gt To x y).
  left~.
  right~. subst. hnf. apply~ total_order_refl.
  right~. rewrite~ total_order_ge_is_rclosure_gt.
   total_order_normalize. hnfs~.
Qed.

Lemma total_order_le_or_gt : forall (To:total_order R) x y,
  le x y \/ gt x y.
Proof using.
  intros. branches~ (total_order_lt_or_eq_or_gt To x y).
  left~. rewrite~ total_order_le_is_rclosure_lt. total_order_normalize. hnfs~.
  left~. subst. apply~ total_order_refl.
Qed.

End TotalOrderProp.

(**************************************************************************)
(* ################################################################# *)
(* * Strict order *)

(** Definition *)

Record strict_order A (R:binary A) : Prop := {
   strict_order_irrefl : irrefl R;
   strict_order_asym : asym R;
   strict_order_trans : trans R }.

Arguments strict_order_trans [A] [R] [s] y [x] [z].

(** Transformations *)

Lemma strict_order_inverse : forall A (R:binary A),
  strict_order R ->
  strict_order (inverse R).
Proof using.
  hint antisym_inverse, trans_inverse, asym_inverse.
  introv [Ir As Tr]. constructor~.
Qed.

Lemma strict_order_strict : forall A (R:binary A),
  order R ->
  strict_order (strict R).
Proof using.
  introv [Re As Tr]. unfold strict. constructor; intros_all; simpls.
  destruct* H.
  applys* antisym_inv x y.
  split. applys* As. intros E. subst. applys* antisym_inv y z.
Qed.

Lemma order_rclosure_of_strict_order : forall A (R:binary A),
  strict_order R ->
  order (rclosure R).
Proof using.
  introv [Re As Tr]. rewrite rclosure_eq_fun. constructor; simpl.
  intros_all~.
  introv [H1|E1] [H2|E2]; subst; auto.
    left. apply* trans_inv.
  introv [H1|E1] [H2|E2]; try subst; auto.
    false. apply* As.
Qed.

(**************************************************************************)
(* ################################################################# *)
(* * Total strict order *)

(** Definition *)

Record strict_total_order A (R:binary A) : Prop := {
   strict_total_order_trans : trans R;
   strict_total_order_trichotomous : trichotomous R }.

Arguments strict_total_order_trans [A] [R] [s] y [x] [z].

(** Conversion to strict order and back *)

Lemma strict_total_order_irrefl : forall A (R:binary A),
  strict_total_order R ->
  irrefl R.
Proof using. introv [Tr Tk]. intros x. lets: (Tk x x). inverts~ H. Qed.

Lemma strict_total_order_asym : forall A (R:binary A),
  strict_total_order R ->
  asym R.
Proof using. introv [Tr Tk]. intros x y. lets: (Tk x y). inverts~ H. Qed.

Coercion strict_total_order_to_strict_order A (R:binary A)
  (O:strict_total_order R) : strict_order R.
Proof using.
  lets [M _]: O. constructor;
  autos~ strict_total_order_irrefl strict_total_order_asym.
Qed.

Hint Resolve strict_total_order_to_strict_order.

(** Transformation *)

Lemma strict_total_order_inverse : forall A (R:binary A),
  strict_total_order R ->
  strict_total_order (inverse R).
Proof using.
  introv [Tr Tk]. constructor. apply~ trans_inverse.
  apply~ trichotomous_inverse.
Qed.
(** From total order *)

Lemma strict_total_order_of_total_order : forall A (R:binary A),
  total_order R ->
  strict_total_order (strict R).
Proof using.
  introv [[Re Tr As] To]. constructor.
  apply~ trans_strict.
  intros x y. tests: (x = y).
    subst. apply trichotomy_eq. unfolds* strict.
    unfold strict. destruct (To x y).
      apply* trichotomy_left.
      apply* trichotomy_right.
Qed.

(* ********************************************************************** *)
(* ################################################################# *)
(** * Definition of order operators *)

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** Classes and notation for comparison operators *)

(** Operators *)

Class Le (A : Type) := { le : binary A }.
Class Ge (A : Type) := { ge : binary A }.
Class Lt (A : Type) := { lt : binary A }.
Class Gt (A : Type) := { gt : binary A }.

Global Opaque le lt ge gt.

(** Structures *)

Class Le_preorder `{Le A} : Prop :=
  { le_preorder : preorder le }.

Class Le_total_preorder `{Le A} : Prop :=
  { le_total_preorder : total_preorder le }.

Class Le_order `{Le A} : Prop :=
  { le_order : order le }.

Class Le_total_order `{Le A} : Prop :=
  { le_total_order : total_order le }.

Class Lt_strict_order `{Lt A} : Prop :=
  { lt_strict_order : strict_order lt }.

Class Lt_strict_total_order `{Lt A} : Prop :=
  { lt_strict_total_order : strict_total_order lt }.

(** Notation *)

Notation "x <= y" := (le x y)
  (at level 70, no associativity) : comp_scope.
Notation "x >= y" := (ge x y)
  (at level 70, no associativity) : comp_scope.
Notation "x < y" := (lt x y)
  (at level 70, no associativity) : comp_scope.
Notation "x > y" := (gt x y)
  (at level 70, no associativity) : comp_scope.

Open Scope comp_scope.

Notation "x <= y <= z" := (x <= y /\ y <= z)
  (at level 70, y at next level) : comp_scope.
Notation "x <= y < z" := (x <= y /\ y < z)
  (at level 70, y at next level) : comp_scope.
Notation "x < y <= z" := (x < y /\ y <= z)
  (at level 70, y at next level) : comp_scope.
Notation "x < y < z" := (x < y /\ y < z)
  (at level 70, y at next level) : comp_scope.

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** The operators [ge], [lt] and [gt] are deduced from [le] *)

Instance ge_of_le : forall `{Le A}, Ge A.
  constructor. apply (inverse le). Defined.
Instance lt_of_le : forall `{Le A}, Lt A.
  constructor. apply (strict le). Defined.
Instance gt_of_le : forall `{Le A}, Gt A.
  constructor. apply (inverse lt). Defined.

Lemma ge_is_inverse_le : forall `{Le A}, ge = inverse le.
Proof using. extens*. Qed.

Lemma lt_is_strict_le : forall `{Le A}, lt = strict le.
Proof using. extens*. Qed.

Lemma gt_is_inverse_lt : forall `{Le A}, gt = inverse lt.
Proof using. extens*. Qed.

Lemma gt_is_inverse_strict_le : forall `{Le A}, gt = inverse (strict le).
Proof using. extens. intros. rewrite gt_is_inverse_lt. rewrite* lt_is_strict_le. Qed.

Global Opaque ge_of_le lt_of_le gt_of_le.

(** Local tactic [rew_to_le] *)

Hint Rewrite @gt_is_inverse_strict_le @ge_is_inverse_le @lt_is_strict_le : rew_to_le.

Tactic Notation "rew_to_le" :=
  autorewrite with rew_to_le in *.

Hint Rewrite @ge_is_inverse_le @gt_is_inverse_lt : rew_to_le_lt.

Tactic Notation "rew_to_le_lt" :=
  autorewrite with rew_to_le_lt in *.

Lemma gt_is_strict_inverse_le : forall `{Le A},
  gt = strict (inverse le).
Proof using. intros. rew_to_le. apply inverse_strict. Qed.

Lemma le_is_rclosure_lt : forall `{Le A},
  refl le ->
  le = rclosure lt.
Proof using. intros. rew_to_le. rewrite~ rclosure_strict. Qed.

Lemma le_is_inverse_ge : forall `{Le A},
  le = inverse ge.
Proof using. intros. rew_to_le. rewrite~ inverse_inverse. Qed.

Lemma lt_is_inverse_gt : forall `{Le A},
  lt = inverse gt.
Proof using. intros. rew_to_le. rewrite~ inverse_inverse. Qed.

Lemma gt_is_strict_ge : forall `{Le A},
  gt = strict ge.
Proof using. intros. rew_to_le. apply inverse_strict. Qed.

Lemma ge_is_rclosure_gt : forall `{Le A},
  refl le ->
  ge = rclosure gt.
Proof using. intros. rewrite gt_is_strict_ge. rewrite~ rclosure_strict. Qed.

(* ********************************************************************** *)
(* ################################################################# *)
(** * Classes for comparison properties *)

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** Definition of classes *)

(** symmetric structure *)

Class Ge_preorder `{Le A} : Prop :=
  { ge_preorder : preorder ge }.
Class Ge_total_preorder `{Le A} : Prop :=
  { ge_total_preorder : total_preorder ge }.
Class Ge_order `{Le A} : Prop :=
  { ge_order : order ge }.
Class Ge_total_order `{Le A} : Prop :=
  { ge_total_order : total_order le }.
Class Gt_strict_order `{Le A} : Prop :=
  { gt_strict_order : strict_order gt }.
Class Gt_strict_total_order `{Le A} : Prop :=
  { gt_strict_total_order : strict_total_order gt }.

(** properties of le *)

Class Le_refl `{Le A} :=
  { le_refl : refl le }.
Class Le_trans `{Le A} :=
  { le_trans : trans le }.
Class Le_antisym `{Le A} :=
  { le_antisym : antisym le }.
Class Le_total `{Le A} :=
  { le_total : total le }.

(** properties of ge *)

Class Ge_refl `{Ge A} :=
  { ge_refl : refl ge }.
Class Ge_trans `{Ge A} :=
  { ge_trans : trans ge }.
Class Ge_antisym `{Ge A} :=
  { ge_antisym : antisym ge }.
Class Ge_total `{Ge A} :=
  { ge_total : total ge }.

(** properties of lt *)

Class Lt_irrefl `{Lt A} :=
  { lt_irrefl : irrefl lt }.
Class Lt_trans `{Lt A} :=
  { lt_trans : trans lt }.

(** properties of gt *)

Class Gt_irrefl `{Gt A} :=
  { gt_irrefl : irrefl gt }.
Class Gt_trans `{Gt A} :=
  { gt_trans : trans gt }.

(** mixed transitivity results *)

Class Lt_le_trans `{Le A} :=
  { lt_le_trans : forall y x z, x < y -> y <= z -> x < z }.
Class Le_lt_trans `{Le A} :=
  { le_lt_trans : forall y x z, x <= y -> y < z -> x < z }.
Class Gt_ge_trans `{Le A} :=
  { gt_ge_trans : forall y x z, x > y -> y >= z -> x > z }.
Class Ge_gt_trans `{Le A} :=
  { ge_gt_trans : forall y x z, x >= y -> y > z -> x > z }.

Arguments lt_irrefl [A] [H] [Lt_irrefl].
Arguments le_trans {A} {H} {Le_trans} y [x] [z].
Arguments ge_trans {A} {H} {Ge_trans} y [x] [z].
Arguments lt_trans {A} {H} {Lt_trans} y [x] [z].
Arguments gt_trans {A} {H} {Gt_trans} y [x] [z].

(** conversion between operators *)

Class Ge_as_sle `{Le A} : Prop :=
  { ge_as_sle : forall x y : A, (x >= y) = (y <= x) }.

Class Gt_as_slt `{Le A} : Prop :=
  { gt_as_slt : forall x y : A, (x > y) = (y < x) }.

Class Ngt_as_sle `{Le A} : Prop :=
  { ngt_as_sle : forall x y : A, (~ x < y) = (y <= x) }.

Class Nlt_as_ge `{Le A} : Prop :=
  { nlt_as_ge : forall x y : A, (~ x < y) = (x >= y) }.

Class Ngt_as_le `{Le A} : Prop :=
  { ngt_as_le : forall x y : A, (~ x > y) = (x <= y) }.

Class Nle_as_gt `{Le A} : Prop :=
  { nle_as_gt : forall x y : A, (~ x <= y) = (x > y) }.

Class Nge_as_lt `{Le A} : Prop :=
  { nge_as_lt : forall x y : A, (~ x >= y) = (x < y) }.

(** inclusion between operators *)

Class Lt_to_le `{Le A} : Prop :=
  { lt_to_le : forall x y : A, (x < y) -> (x <= y) }.

Class Gt_to_ge `{Le A} : Prop :=
  { gt_to_ge : forall x y : A, (x > y) -> (x >= y) }.

Class Nle_to_sle `{Le A} : Prop :=
  { nle_to_sle : forall x y : A, (~ x <= y) -> (y <= x) }.

Class Nle_to_slt `{Le A} : Prop :=
  { nle_to_slt : forall x y : A, (~ x <= y) -> (y < x) }.

(** case analysis *)

Class Case_eq_lt_gt `{Le A} : Prop :=
  { case_eq_lt_gt : forall x y : A, x = y \/ x < y \/ x > y }.

Class Case_eq_lt_slt `{Le A} : Prop :=
  { case_eq_lt_slt : forall x y : A, x = y \/ x < y \/ y < x }.

Class Case_le_gt `{Le A} : Prop :=
  { case_le_gt : forall x y : A, x <= y \/ x > y }.

Class Case_le_slt `{Le A} : Prop :=
  { case_le_slt : forall x y : A, x <= y \/ y < x }.

Class Case_lt_ge `{Le A} : Prop :=
  { case_lt_ge : forall x y : A, x < y \/ x >= y }.

Class Case_lt_sle `{Le A} : Prop :=
  { case_lt_sle : forall x y : A, x < y \/ y <= x }.

(** case analysis under one assumption *)

Class Neq_case_lt_gt `{Le A} : Prop :=
  { neq_case_lt_gt : forall x y : A, x <> y -> x < y \/ x > y }.

Class Neq_case_lt_slt `{Le A} : Prop :=
  { neq_case_lt_slt : forall x y : A, x <> y -> x < y \/ y < x }.

Class Le_case_eq_lt `{Le A} : Prop :=
  { le_case_eq_lt : forall x y : A, x <= y -> x = y \/ x < y }.

Class Ge_case_eq_gt `{Le A} : Prop :=
  { ge_case_eq_gt : forall x y : A, x >= y -> x = y \/ x > y }.

(** case analysis under two assumptions *)

Class Le_neq_to_lt `{Le A} : Prop :=
  { le_neq_to_lt : forall x y : A, x <= y -> x <> y -> x < y }.

Class Ge_neq_to_gt `{Le A} : Prop :=
  { ge_neq_to_gt : forall x y : A, x >= y -> x <> y -> x > y }.

Class Nlt_nslt_to_eq `{Le A} : Prop :=
  { nlt_nslt_to_eq : forall x y : A, ~ (lt x y) -> ~ (lt y x) -> x = y }.

(** contradiction from case analysis *)

Class Lt_ge_false `{Le A} : Prop :=
  { lt_ge_false : forall x y : A, x < y -> x >= y -> False }.

Class Lt_gt_false `{Le A} : Prop :=
  { lt_gt_false : forall x y : A, x < y -> x > y -> False }.

Class Lt_slt_false `{Le A} : Prop :=
  { lt_slt_false : forall x y : A, x < y -> y < x -> False }.

(* ********************************************************************** *)
(* ################################################################# *)
(* * Instances for comparison structures *)

Section Instances.
Context `{Le A}.

Ltac auto_star ::= try solve [ dauto ].

(** derived structures *)

Global Instance Le_preorder_of_Le_order :
  Le_order ->
  Le_preorder.
Proof using. constructor. intros. apply* order_to_preorder. Qed.

Global Instance Le_total_preorder_of_Le_total_order :
  Le_total_order ->
  Le_total_preorder.
Proof using. constructor. intros. apply* total_order_to_total_preorder. Qed.

Global Instance Le_preorder_of_Total_preorder :
  Le_total_preorder ->
  Le_preorder.
Proof using. constructor. intros. apply* total_preorder_to_preorder. Qed.

Global Instance Le_order_of_Le_total_order :
  Le_total_order ->
  Le_order.
Proof using. constructor. intros. apply* total_order_to_order. Qed.

Global Instance lt_strict_order_of_lt_strict_total_order :
  Lt_strict_total_order ->
  Lt_strict_order.
Proof using. constructor. intros. apply* strict_total_order_to_strict_order. Qed.

Global Instance Lt_strict_order_of_Le_order :
  Le_order ->
  Lt_strict_order.
Proof using. constructor. intros. rew_to_le. apply* strict_order_strict. Qed.

Global Instance Lt_strict_total_order_of_Le_total_order :
  Le_total_order ->
  Lt_strict_total_order.
Proof using. constructor. intros. rew_to_le. apply* strict_total_order_of_total_order. Qed.

(** symmetric structures *)

Global Instance Ge_preorder_of_Le_order :
  Le_order ->
  Ge_preorder.
Proof using. constructor. rew_to_le. apply preorder_inverse. apply le_preorder. Qed.

Global Instance Ge_total_preorder_of_Le_total_order :
  Le_total_order ->
  Ge_total_preorder.
Proof using. constructor. rew_to_le. apply total_preorder_inverse. apply le_total_preorder. Qed.

Global Instance Ge_preorder_of_Total_preorder :
  Le_total_preorder ->
  Ge_preorder.
Proof using. constructor. rew_to_le. apply preorder_inverse. apply le_preorder. Qed.

Global Instance Ge_order_of_Le_total_order :
  Le_total_order ->
  Ge_order.
Proof using. constructor. rew_to_le. apply order_inverse. apply le_order. Qed.

Global Instance Gt_strict_order_of_lt_strict_total_order :
  Lt_strict_total_order ->
  Gt_strict_order.
Proof using. constructor. rewrite gt_is_inverse_lt. apply strict_order_inverse. apply lt_strict_order. Qed.

Global Instance Gt_strict_order_of_Le_order :
  Le_order ->
  Gt_strict_order.
Proof using. constructor. rewrite gt_is_inverse_lt. apply strict_order_inverse. apply lt_strict_order. Qed.

Global Instance Gt_strict_total_order_of_Le_total_order :
  Le_total_order ->
  Gt_strict_total_order.
Proof using. constructor. rewrite gt_is_inverse_lt. apply strict_total_order_inverse. apply lt_strict_total_order. Qed.

(** properties of le *)

Global Instance Le_refl_of_Le_preorder :
  Le_preorder ->
  Le_refl.
Proof using. intros [[Re Tr]]. constructor~. Qed.

Global Instance Le_trans_of_Le_preorder :
  Le_preorder ->
  Le_trans.
Proof using. intros [[Re Tr]]. constructor~. Qed.

Global Instance Le_antisym_of_Le_order :
  Le_order ->
  Le_antisym.
Proof using. constructor. intros. apply* order_antisym. Qed.

Global Instance Le_total_of_Le_total_order :
  Le_total_order ->
  Le_total.
Proof using. constructor. intros. apply* total_order_total. Qed.

(** properties of ge *)

Global Instance Ge_refl_of_Le_preorder :
  Le_preorder ->
  Ge_refl.
Proof using. constructor. rew_to_le. apply refl_inverse. apply le_refl. Qed.

Global Instance Ge_trans_of_Le_preorder :
  Le_preorder ->
  Ge_trans.
Proof using. constructor. rew_to_le. apply trans_inverse. apply le_trans. Qed.

Global Instance Ge_antisym_of_Le_order :
  Le_order ->
  Ge_antisym.
Proof using. constructor. rew_to_le. apply antisym_inverse. apply le_antisym. Qed.

Global Instance Ge_total_of_Le_total_order :
  Le_total_order ->
  Ge_total.
Proof using. constructor. rew_to_le. apply total_inverse. apply le_total. Qed.

(** properties of lt *)

Global Instance Lt_irrefl_of_Le_order :
  Le_order ->
  Lt_irrefl.
Proof using. constructor. apply strict_order_irrefl. apply lt_strict_order. Qed.

Global Instance Lt_trans_of_Le_order :
  Le_order ->
  Lt_trans.
Proof using. constructor. apply strict_order_trans. apply lt_strict_order. Qed.

(** properties of gt *)

Global Instance Gt_irrefl_of_Le_order :
  Le_order ->
  Gt_irrefl.
Proof using. constructor. apply strict_order_irrefl. apply gt_strict_order. Qed.

Global Instance Gt_trans_of_Le_order :
  Le_order ->
  Gt_trans.
Proof using. constructor. apply strict_order_trans. apply gt_strict_order. Qed.

(** mixed transitivity results *)

Global Instance Lt_le_trans_of_Le_order :
  Le_order ->
  Lt_le_trans.
Proof using.
  constructor. introv K L. rew_to_le. destruct K as [U V].
  split~. apply* le_trans. intro_subst. apply V. apply* le_antisym.
Qed.

Global Instance Le_lt_trans_of_Le_order :
  Le_order ->
  Le_lt_trans.
Proof using.
  constructor. introv K L. rew_to_le. destruct L as [U V].
  split~. apply* le_trans. intro_subst. apply V. apply* le_antisym.
Qed.

Global Instance gt_ge_trans_of_Le_order :
  Le_order ->
  Gt_ge_trans.
Proof using.
  constructor. introv K L. rew_to_le_lt. hnf in *. apply* le_lt_trans.
Qed.

Global Instance ge_gt_trans_of_Le_order :
  Le_order ->
  Ge_gt_trans.
Proof using.
  constructor. introv K L. rew_to_le_lt. hnf in *. apply* lt_le_trans.
Qed.
(** conversion between operators *)

Global Instance Ge_as_sle_of :
  Ge_as_sle.
Proof using. constructor. intros. rew_to_le. auto. Qed.

Global Instance Gt_as_slt_of :
  Gt_as_slt.
Proof using. constructor. intros. rew_to_le. auto. Qed.

Global Instance Ngt_as_sle_of_Le_total_order :
  Le_total_order ->
  Ngt_as_sle.
Proof using.
  constructor. intros. rew_to_le. unfold strict. rew_logic. iff M.
  destruct M.
    forwards K:(inverse_strict_of_not (R:=le)); eauto.
      apply le_total. apply (proj1 K).
    subst. apply le_refl.
  apply or_classic_l. intros P Q. apply P. apply* le_antisym.
Qed.

Global Instance Nlt_as_ge_of_Le_total_order :
  Le_total_order ->
  Nlt_as_ge.
Proof using. constructor. intros. rew_to_le_lt. unfold inverse. apply ngt_as_sle. Qed.

Global Instance Ngt_as_le_of_Le_total_order :
  Le_total_order ->
  Ngt_as_le.
Proof using. constructor. intros. rew_to_le_lt. unfold inverse. apply ngt_as_sle. Qed.

Global Instance Nle_as_gt_of_Le_total_order :
  Le_total_order ->
  Nle_as_gt.
Proof using.
  constructor. intros. rew_to_le_lt. unfold inverse.
  rewrite <- ngt_as_sle. rewrite~ not_not_eq.
Qed.

Global Instance Nge_as_lt_of_Le_total_order :
  Le_total_order ->
  Nge_as_lt.
Proof using.
  constructor. intros. rew_to_le_lt. unfold inverse.
  rewrite nle_as_gt. rewrite~ gt_is_inverse_lt.
Qed.

(** inclusion between operators *)

Global Instance Lt_to_le_of :
  Lt_to_le.
Proof using. constructor. intros. rew_to_le. unfolds* strict. Qed.

Global Instance Gt_to_ge_of :
  Gt_to_ge.
Proof using. constructor. intros. rew_to_le. unfolds* inverse, strict. Qed.

Global Instance Nle_to_sle_of_Le_total_order :
  Le_total_order ->
  Nle_to_sle.
Proof using.
  constructor. introv K. rewrite nle_as_gt in K.
  rew_to_le. unfolds* inverse, strict.
Qed.

Global Instance Nle_to_slt_of_Le_total_order :
  Le_total_order ->
  Nle_to_slt.
Proof using.
  constructor. introv K. rewrite nle_as_gt in K.
  rew_to_le. unfolds* inverse, strict.
Qed.

(** case analysis under no assumption *)

Global Instance Case_eq_lt_gt_of_Le_total_order :
  Le_total_order ->
  Case_eq_lt_gt.
Proof using.
  introv K. constructor. intros.
  lets [(M1&M2)|[M|(M1&M2)]]: (total_order_lt_or_eq_or_gt le_total_order x y).
    rewrite le_is_rclosure_lt in M1 by applys* total_order_refl. destruct* M1.
    autos*.
    rewrite le_is_rclosure_lt in M1 by applys* total_order_refl. destruct* M1.
Qed.

Global Instance Case_eq_lt_slt_of_Le_total_order :
  Le_total_order ->
  Case_eq_lt_slt.
Proof using.
  constructor. intros. pattern lt at 2. rewrite lt_is_inverse_gt.
  apply case_eq_lt_gt.
Qed.

Global Instance Case_le_gt_of_Le_total_order :
  Le_total_order ->
  Case_le_gt.
Proof using.
  constructor. intros.
  rewrite le_is_rclosure_lt by applys* total_order_refl. rewrite rclosure_eq.
  branches (total_order_lt_or_eq_or_gt le_total_order x y); eauto.
Qed.

Global Instance Case_eq_lt_ge_of_Le_total_order :
  Le_total_order ->
  Case_lt_ge.
Proof using.
  constructor. intros.
  rewrite ge_is_rclosure_gt by applys* total_order_refl. rewrite rclosure_eq.
  branches (total_order_lt_or_eq_or_gt le_total_order x y); eauto.
Qed.

Global Instance Case_le_slt_of_Le_total_order :
  Le_total_order ->
  Case_le_slt.
Proof using. constructor. intros. rewrite lt_is_inverse_gt. apply case_le_gt. Qed.

Global Instance Case_eq_lt_sle_of_Le_total_order :
  Le_total_order ->
  Case_lt_sle.
Proof using. constructor. intros. rewrite le_is_inverse_ge. apply case_lt_ge. Qed.

(** case analysis under one assumption *)

Global Instance Neq_case_lt_gt_of_Le_total_order :
  Le_total_order ->
  Neq_case_lt_gt.
Proof using. constructor. intros. destruct* (case_eq_lt_gt x y). Qed.

Global Instance Neq_case_lt_slt_of_Le_total_order :
  Le_total_order ->
  Neq_case_lt_slt.
Proof using. constructor. intros. destruct* (case_eq_lt_gt x y). Qed.

Global Instance Le_case_eq_lt_of_Le_total_order :
  Le_total_order ->
  Le_case_eq_lt.
Proof using. constructor. intros. rew_to_le. unfold strict. tests*: (x = y). Qed.

Global Instance Ge_case_eq_gt_of_Le_total_order :
  Le_total_order ->
  Ge_case_eq_gt.
Proof using. constructor. intros. rew_to_le. unfold inverse, strict. tests*: (x = y). Qed.

(** case analysis under two assumptions *)

Global Instance Le_neq_to_lt_of_Le_total_order :
  Le_total_order ->
  Le_neq_to_lt.
Proof using. constructor. intros. rew_to_le. hnfs*. Qed.

Global Instance Ge_neq_to_gt_of_Le_total_order :
  Le_total_order ->
  Ge_neq_to_gt.
Proof using. constructor. intros. rew_to_le. hnfs*. Qed.

Global Instance Nlt_nslt_to_eq_of_Le_total_order :
  Le_total_order ->
  Nlt_nslt_to_eq.
Proof using. constructor. intros. branches* (case_eq_lt_gt x y). Qed.

(** contradiction from case analysis *)

Global Instance Lt_ge_false_of_Le_total_order :
  Le_total_order ->
  Lt_ge_false.
Proof using. constructor. introv H1 H2. rewrite~ <- nlt_as_ge in H2. Qed.

Global Instance Lt_gt_false_of_Le_total_order :
  Le_total_order ->
  Lt_gt_false.
Proof using.
  constructor. introv H1 H2. rewrite~ <- nle_as_gt in H2.
  apply H2. apply* lt_to_le.
Qed.

Global Instance Lt_slt_false_of_Le_total_order :
  Le_total_order ->
  Lt_slt_false.
Proof using.
  constructor. introv H1 H2. rewrite <- gt_as_slt in H2.
  apply* lt_gt_false.
Qed.

End Instances.

(** -- Other lemmas needs arguments to be implicit? *)

(* ********************************************************************** *)
(* ################################################################# *)
(** * Boolean comparison *)

Module BooleanComparison.
Open Scope comp_scope.

(** Additional notation for reflected boolean comparison.
    Use [Open Scope comp_scope_reflect] to use them. *)

Notation "x ''<=' y" := (isTrue (@le _ _ x y))
  (at level 70, no associativity) : comp_scope_reflect.
Notation "x ''>=' y" := (isTrue (@ge _ _ x y))
  (at level 70, no associativity) : comp_scope_reflect.
Notation "x ''<' y" := (isTrue (@lt _ _ x y))
  (at level 70, no associativity) : comp_scope_reflect.
Notation "x ''>' y" := (isTrue (@gt _ _ x y))
  (at level 70, no associativity) : comp_scope_reflect.

End BooleanComparison.

(* ********************************************************************** *)
(* ################################################################# *)
(** * Order on relations and on predicates *)

Lemma order_rel_incl : forall A B,
  order (@rel_incl A B).
Proof using.
  hint refl_rel_incl, antisym_rel_incl, trans_rel_incl.
  constructors*.
Qed.

Lemma order_pred_incl : forall A B,
  order (@rel_incl A B).
Proof using.
  hint refl_rel_incl, antisym_rel_incl, trans_rel_incl.
  constructors*.
Qed.

(* 2020-03-09 15:04:12 (UTC+01) *)


(* We consider the discrete plan the coordinate system of which
    is based on Z *)
Require Import List  ZArith  Bool.
Open Scope Z_scope.
Require Import Relations  Setoid  Morphisms  RelationClasses.
Require Import EMonoid.

(** Types for representing routes in the dicrete  plane *)

Inductive direction : Type := North | East | South | West.
Definition route := list direction.

Record Point : Type :=
 {Point_x : Z;
  Point_y : Z}.

Definition Point_O := Build_Point 0 0.

Definition translate (dx dy:Z) (P : Point) :=
  Build_Point (Point_x P + dx) (Point_y P + dy).

(** Equality test  between Points *)

Definition Point_eqb (P P':Point) :=
   Zeq_bool (Point_x P) (Point_x P') &&
   Zeq_bool (Point_y P) (Point_y P').

(* Prove the correctness of Point_eqb *)

Lemma Point_eqb_correct : forall p p', Point_eqb p p' = true <->
                                       p = p'.
Proof.
 destruct p;destruct p';simpl;split.
 -  unfold Point_eqb; simpl; rewrite andb_true_iff; destruct 1.
    repeat rewrite <- Zeq_is_eq_bool in *.
    now  rewrite H, H0.
 -  injection 1;intros H0 H1;rewrite H0, H1; unfold Point_eqb; simpl;
    rewrite andb_true_iff;repeat rewrite <- Zeq_is_eq_bool; now split.
Qed.

(**  (move P r) follows the route r starting from P *)

Fixpoint move (r:route) (P:Point) : Point :=
 match r with
 | nil => P
 | North :: r' => move r' (translate 0 1 P)
 | East :: r' => move r' (translate 1 0 P)
 | South :: r' => move r' (translate 0 (-1) P)
 | West :: r' => move r' (translate (-1) 0 P)
 end.

(**  We consider that two routes are "equivalent" if they define
  the same moves. For instance, the routes
  East::North::West::South::East::nil and East::nil are equivalent *)

Definition route_equiv : relation route :=
  fun r r' => forall P:Point , move r P = move  r' P.

Infix "=r=" := route_equiv (at level 70):type_scope.

Example Ex1 : East::North::West::South::East::nil =r= East::nil.
Proof.
 intro P;destruct P;simpl; unfold route_equiv, translate;simpl;f_equal; ring.
Qed.

Lemma route_equiv_refl : reflexive _ route_equiv.
Proof.  intros r p;reflexivity. Qed.

Lemma route_equiv_sym : symmetric _ route_equiv.
Proof.  intros r r' H p; symmetry;apply H. Qed.

Lemma route_equiv_trans : transitive _ route_equiv.
Proof.  intros r r' r'' H H' p; rewrite H; apply H'. Qed.

Instance route_equiv_Equiv : Equivalence  route_equiv.
Proof.
split;  [apply route_equiv_refl |  apply route_equiv_sym |  apply route_equiv_trans].
Qed.

(* Cons and app are Proper functions w.r.t. route_equiv *)

Lemma route_cons : forall r r' d, r =r= r' -> d::r =r= d::r'.
Proof.
 intros r r' d H P;destruct d;simpl;rewrite H;reflexivity.
Qed.

Example Ex2 :  South::East::North::West::South::East::nil =r= South::East::nil.
Proof. apply route_cons;apply Ex1. Qed.

Instance cons_route_Proper (d:direction):
    Proper (route_equiv ==> route_equiv) (cons d) .
Proof.
 intros r r' H ; now apply route_cons.
Qed.

(**  cons_route_Proper allows to replace a route with an =r= equivalent one
     in a context composed by "cons" *)

Example SW : forall r r', r =r= r' ->
                  South::West::r =r= South::West::r'.
Proof.
 intros r r' H; now rewrite H.
Qed.

Instance move_Proper  : Proper (route_equiv ==> @eq Point ==> @eq Point) move .
Proof.
 intros r r' Hr_r' p q Hpq; rewrite Hpq; apply Hr_r'.
Qed.

Example length_not_Proper : ~Proper (route_equiv ==> @eq nat) (@length _).
Proof.
 intro H; generalize (H (North::South::nil) nil);simpl;intro H0.
 discriminate H0.
 -  intro P;destruct P; simpl;unfold translate; simpl;f_equal;simpl;ring.
Qed.

Lemma route_compose : forall r r' P, move (r++r') P = move r' (move r P).
Proof.
 induction r as [|d s IHs]; simpl;
 [auto | destruct d; intros;rewrite IHs;auto].
Qed.

Instance app_route_Proper : Proper (route_equiv==>route_equiv ==> route_equiv)
 (@app direction).
Proof.
 intros r r' H r'' r''' H' P.
 repeat rewrite route_compose; rewrite H, H';reflexivity.
Qed.

Example Ex3 : forall r, North::East::South::West::r =r= r.
Proof.
 intros r P;destruct P;simpl;
  unfold route_equiv, translate;simpl;do 2 f_equal;ring.
Qed.

Example Ex4 : forall r r', r =r= r' ->
                North::East::South::West::r =r= r'.
Proof. intros r r' H. now rewrite Ex3. Qed.

Example Ex5 : forall r r',  r++ North::East::South::West::r' =r= r++r'.
Proof. intros r r'; now rewrite Ex3. Qed.

Lemma translate_comm : forall dx dy dx' dy' P,
    translate dx dy (translate dx' dy' P) =
    translate dx' dy' (translate dx dy P).
Proof.
  unfold translate; simpl; intros; f_equal; ring.
 Qed.

Lemma move_translate : forall r P dx dy , move r (translate dx dy P) =
                                                translate dx dy (move r P).
Proof.
 induction r as [|a r];simpl;[reflexivity|].
 destruct a;simpl; intros;rewrite <- IHr;rewrite  (translate_comm );auto.
Qed.

Lemma move_comm : forall r r' P  , move r (move r' P)  =
                                   move r' (move r P) .
Proof.
induction r as [| a r'];[reflexivity|].
- simpl;destruct a;
 intros;repeat rewrite move_translate;rewrite IHr';auto.
Qed.

Lemma app_comm : forall r r', r++r' =r=  r'++r.
Proof.
 intros r r' P;repeat rewrite route_compose; apply move_comm.
Qed.

(** the following lemma  will be used for deciding route equivalence *)

Lemma route_equiv_Origin : forall r r', r =r= r' <->
                                        move r Point_O  = move r' Point_O .
Proof.
split;intro H.
- now rewrite H.
- intro P;replace P with (translate (Point_x P) (Point_y P) Point_O).
 +   repeat rewrite move_translate.
     rewrite H;reflexivity.
 + destruct P;simpl;unfold translate;f_equal.
Qed.

Definition route_eqb r r' : bool :=
   Point_eqb (move r Point_O) (move r' Point_O).

(**  ... we can now prove route_eqb's  correctness *)

Lemma route_equiv_equivb : forall r r', route_equiv r r' <->
                                        route_eqb r r' = true.
Proof.
 intros r r' ; rewrite route_equiv_Origin;
 unfold route_eqb;rewrite Point_eqb_correct;tauto.
Qed.

Ltac route_eq_tac := rewrite route_equiv_equivb;reflexivity.

(** another proof of Ex1, using computation  *)

Example Ex1' : East::North::West::South::East::nil =r= East::nil.
Proof. route_eq_tac. Qed.

Lemma north_south_0 : forall r, North::South::r =r=  r.
Proof.
 intro r; change ((North::South::nil)++ r =r=  r).
 setoid_replace (North :: South :: nil) with  (@nil direction);
  [reflexivity |route_eq_tac ].
Qed.

Lemma north_south_simpl : forall r r', r++ North::South::r' =r=  r++r'.
Proof.
 induction r as [|a r'];simpl.
 -  intro r';rewrite north_south_0;reflexivity.
 -  intros r1;now rewrite IHr' .
Qed.

(* we want to prove that, if some route contains two steps in opposite
   directions, then the route can be shortened *)

Definition opposite (d d':direction):= match d,d' with
        | North,South => True
        | South, North => True
        | East, West => True
        | West, East => True
        | _, _ => False
end.

Inductive  Useless_steps_in (r:route) : Type :=
Useless_i: forall r0 r1 r2 d d1,  r = r0++(d::r1)++(d1::r2) ->
                                  opposite d d1 ->
                                  Useless_steps_in r.

Lemma opposite_cons : forall d d1 r, opposite d d1 -> d1::d::r =r= r.
Proof.
 intros d d1 r H;destruct d,d1;simpl ;try contradiction ;
 intro P;destruct P;simpl;auto; unfold translate;simpl; repeat f_equal;ring.
Qed.

Lemma cons2_comm : forall d d' r, d::d'::r =r= d'::d::r.
Proof.
 intros d d' r; change ((d::nil)++(d'::nil)++r =r= (d'::nil)++(d::nil)++r).
 do 2  rewrite <- app_ass.
 rewrite (app_comm  (d :: nil) (d'::nil));reflexivity.
Qed.

Lemma Useless_steps_shorter (r:route) :
  Useless_steps_in r -> {r' : route | r =r= r' /\ (length r' < length r)%nat}.
Proof.
 intro H;destruct H as [r0 r1 r2 d d1 H1 H2].
 exists (r0 ++ r1 ++ r2).
 split.
 -  subst r; replace (r0 ++ (d :: r1) ++ d1 :: r2) with
         (r0 ++ ((d::nil) ++ r1) ++ ((d1::nil)++r2))  by (simpl;auto).
     apply app_route_Proper;[reflexivity|].
     rewrite <- app_ass.
     apply app_route_Proper;[|reflexivity].
     transitivity ((d1::nil)++(d::r1)).
     rewrite app_comm; reflexivity.
      simpl;rewrite opposite_cons;[reflexivity|trivial].
 -  subst r; repeat (simpl;repeat  rewrite app_length); omega.
Qed.

(** Monoid structure on routes *)

Instance Route : EMonoid route_equiv (@app _)  nil .
Proof.
split.
- apply route_equiv_Equiv.
- apply app_route_Proper.
- intros x y z P;repeat rewrite  route_compose; trivial.
-  intros x  P;repeat rewrite  route_compose; trivial.
- intros x  P;repeat rewrite  route_compose; trivial.
Qed.

Example Ex6 : forall n, Epower (South::North::nil) n =r= nil.
Proof.
 induction n as [| p IHp];simpl;[reflexivity|].
 rewrite IHp; route_eq_tac.
Qed.

Instance AbelianRoute : Abelian_EMonoid Route.
  split;  apply app_comm.
Qed.


Require Import NArith.
Require Import PolTac.

Open Scope N_scope.

Theorem pols_test1 x y :
  x < y -> x + x < y + x.
Proof.
intros.
pols.
auto.
Qed.

Theorem pols_test2 x y :
  y < 0 -> x + y < x.
Proof.
intros.
pols.
auto.
Qed.

Theorem pols_test3 x y :
  x * x < y * y ->
  (x + y) * (x + y) < 2 * (x * y + y * y).
Proof.
intros.
pols.
auto.
Qed.

Theorem pols_test4 x y z :
  x + y * (y + z) = 2 * z ->
  2 * x + y * (y + z) = x + z + z.
Proof.
intros.
pols.
auto.
Qed.

Theorem polf_test1 x y :
  1 <= y -> x <= x * y.
Proof.
intros.
polf.
Qed.

Theorem polf_test2 x y :
  0 < x -> x <= x * y -> 1 <= y.
Proof.
intros H1 H2.
hyp_polf H2.
auto.
Qed.

Theorem polr_test1 x y z :
  x + z < y -> x + y + z < 2 * y.
Proof.
intros H.
polr H.
pols.
auto.
pols.
auto.
Qed.


(**
 * PSet 1: Functional Programming in Coq

  This lab is designed as a file that you should download and complete in a Coq IDE.
  Before doing that, you need to install Coq.  The installation instructions
  are on the course website.
*)

(* Exercise: mult2 [10 points].
   Define a function that multiplies its input by 2.
   What is the function's type?
   What is the result of computing the function on 0?  On 3110?
*)

(* Exercise: xor [10 points].
   Define a function that computes the xor of two [bool] inputs.
   Do this by pattern matching on the inputs.
   What is the function's type?
   Compute all four possible combinations of inputs to test your function.
*)

(* Exercise: is_none [20 points].
   Define a function that returns [true] if its input is [None], and [false] otherwise.
   Your function's type should be [forall A : Type, option A -> bool].
   That means the function will actually need to take two inputs:
     the first has type [Type], and the second is an option.
   Hint:  model your solution on [is_empty] in the notes for this lecture.
*)

Require Import List.
Import ListNotations.

(* Exercise: double_all [20 points].
   There is a function [map] that was imported by the [Require Import List] command above.
   First, check its type with [Check map].  Explain that type in your own words.
   Second, print it with [Print map].  Note at the end of that which arguments are _implicit_.
   For a discussion of what implicit means, see the notes for this lecture.
   Third, use map to write your own function, which should double (i.e., multiply by 2)
   every value of a list.
   For example, [double_all [0;2;10]] should be [[0;4;20]].
*)

(* Exercise: sum [20 points]
   Write a function that sums all the natural numbers in a list.
   Implement this two different ways:
   - as a recursive function, using the [Fixpoint] syntax.
   - as a nonrecursive function, using [Definition] and an application of [fold_left].
*)

Inductive day : Type :=
  | sun : day
  | mon : day
  | tue : day
  | wed : day
  | thu : day
  | fri : day
  | sat : day.

Definition next_day d :=
  match d with
  | sun => mon
  | mon => tue
  | tue => wed
  | wed => thu
  | thu => fri
  | fri => sat
  | sat => sun
  end.

(* Exercise: thu after wed [20 points].
   State a theorem that says [thu] is the [next_day] after [wed].
   Write down in natural language how you would informally explain
   to a human why this theorem is true.
   ---> Don't skip this "natural language" part of the exercise;
        it's crucial to develop intuition before proceeding.
   Prove the theorem in Coq.
*)

(* Exercise: wed before thu [30 points].
   Below is a theorem that says if the day after [d] is [thu], then
   [d] must be [wed].
   Write down in natural language how you would informally explain
   to a human why this theorem is true.
   ---> Don't skip this "natural language" part of the exercise;
        it's crucial to develop intuition before proceeding.
   Prove the theorem in Coq.  To do that, delete the [Abort]
   command, which tells Coq to discard the theorem,
   then fill in your own proof.
*)

Theorem wed_proceeds_thu : forall d : day, next_day d = thu -> d = wed.
Abort.

(* Exercise: tl_opt [20 points].
   Define a function [tl_opt] such that [tl_opt lst] return [Some t] if [t] is the tail of [lst],
   or [None] if [lst] is empty.
   We have gotten you started by providing an obviously incorrect definition, below; you should
   replace the body of the function with a correct definition.
*)

Definition tl_opt {A : Type} (lst : list A) : option (list A) :=
  None.

(* Here is a new tactic: [rewrite x].  If [H: x = e] is an assumption in the
   proof state, then [rewrite H] replaces [x] with [e] in the subgoal being proved.  For example,
   here is a proof that incrementing 1 produces 2: *)

Theorem inc1_is_2 : forall n, n=1 -> (fun x => x+1) n = 2.
Proof.
  intros n n_is_1. rewrite n_is_1. trivial.
Qed.

(* Exercise: tl_opt correct [20 points].
   Using [rewrite], prove the following theorems. For both, first explain in natural language
   why the theorem should hold, before moving on to prove it with Coq. *)

Theorem nil_implies_tlopt_none :
  forall A : Type, forall lst : list A,
  lst = nil -> tl_opt lst = None.
Abort.

Theorem cons_implies_tlopt_some :
  forall {A : Type} (h:A) (t : list A) (lst : list A),
  lst = h::t -> tl_opt lst = Some t.
Abort.


Welcome to Coq ciosx:/builds/workspace/coq-8.5pl3-macos,(detached from 2290dbb) (2290dbb9c95b63e693ced647731623e64297f5c8)

Coq < Module Playground2.
Interactive Module Playground2 started

Coq < Require Import Arith Classical.
[Loading ML file z_syntax_plugin.cmxs ... done]
[Loading ML file quote_plugin.cmxs ... done]
[Loading ML file newring_plugin.cmxs ... done]
<W> Grammar extension: in [tactic:simple_tactic], some rule has been masked
<W> Grammar extension: in [tactic:simple_tactic], some rule has been masked
<W> Grammar extension: in [tactic:simple_tactic], some rule has been masked
<W> Grammar extension: in [tactic:simple_tactic], some rule has been masked
<W> Grammar extension: in [tactic:simple_tactic], some rule has been masked

Coq < Fixpoint plus (n : nat) (m : nat) : nat := match n with | O => m | S n' => S (plus n' m) end.
plus is defined
plus is recursively defined (decreasing on 1st argument)

Coq < Fixpoint mult (n m : nat) : nat := match n with | O => O | S n' => plus m (mult n' m) end.
mult is defined
mult is recursively defined (decreasing on 1st argument)

Coq < Fixpoint minus (n m:nat) : nat := match n, m with | O , _ => O | S _ , O => n | S n', S m' => minus n' m' end.
minus is defined
minus is recursively defined (decreasing on 1st argument)

Coq < End Playground2.
Module Playground2 is defined

Coq < Fixpoint exp (base power : nat) : nat := match power with | O => S O | S p => mult base (exp base p) end.
exp is defined
exp is recursively defined (decreasing on 2nd argument)

Coq < Notation "x + y" := (plus x y) (at level 50 , left associativity) : nat_scope.

Coq < Notation "x - y" := (minus x y) (at level 50, left associativity) : nat_scope.

Coq < Check ((0 + 1) + 1).
0 + 1 + 1
     : nat

Coq < Compute 1 + 2.
     = 3
     : nat

Coq < Compute 4 - 1.
     = 3
     : nat

Coq < Compute 4 * 2.
     = 8
     : nat

Coq < Fixpoint beq_nat (n m : nat) : bool := match n with | O => match m with | O => true | S m' => false end | S n' => match m with | O => false | S m' => beq_nat n' m' end end.
beq_nat is defined
beq_nat is recursively defined (decreasing on 1st argument)

Coq < Fixpoint leb (n m : nat) : bool := match n with | O => true | S n' => match m with | O => false | S m' => leb n' m' end end.
leb is defined
leb is recursively defined (decreasing on 1st argument)

Coq < Example test_leb1: (leb 2 2) = true.
1 subgoal

  ============================
  leb 2 2 = true

test_leb1 < Proof.
1 subgoal

  ============================
  leb 2 2 = true

test_leb1 < simpl.
1 subgoal

  ============================
  true = true

test_leb1 < reflexivity.
No more subgoals.

test_leb1 < Qed.
Proof.
simpl.
reflexivity.

Qed.
test_leb1 is defined

Coq < Example test_leb2: (leb 2 4) = true.
1 subgoal

  ============================
  leb 2 4 = true

test_leb2 < Proof.
1 subgoal

  ============================
  leb 2 4 = true

test_leb2 < simpl.
1 subgoal

  ============================
  true = true

test_leb2 < reflexivity.
No more subgoals.

test_leb2 < Qed.
Proof.
simpl.
reflexivity.

Qed.
test_leb2 is defined

Coq < Example test_leb3: (leb 4 2) = false.
1 subgoal

  ============================
  leb 4 2 = false

test_leb3 < Proof.
1 subgoal

  ============================
  leb 4 2 = false

test_leb3 < simpl.
1 subgoal

  ============================
  false = false

test_leb3 < reflexivity.
No more subgoals.

test_leb3 < Qed.
Proof.
simpl.
reflexivity.

Qed.
test_leb3 is defined


(** * Logic: Logic in Coq *)

Require Export MoreCoq.

(** Coq's built-in logic is very small: the only primitives are
    [Inductive] definitions, universal quantification ([forall]), and
    implication ([->]), while all the other familiar logical
    connectives -- conjunction, disjunction, negation, existential
    quantification, even equality -- can be encoded using just these.

    This chapter explains the encodings and shows how the tactics
    we've seen can be used to carry out standard forms of logical
    reasoning involving these connectives. *)

(* ########################################################### *)
(** * Propositions *)

(** In previous chapters, we have seen many examples of factual
    claims (_propositions_) and ways of presenting evidence of their
    truth (_proofs_).  In particular, we have worked extensively with
    _equality propositions_ of the form [e1 = e2], with
    implications ([P -> Q]), and with quantified propositions
    ([forall x, P]).
*)

(** In Coq, the type of things that can (potentially)
    be proven is [Prop]. *)

(** Here is an example of a provable proposition: *)

Check (3 = 3).
(* ===> Prop *)

(** Here is an example of an unprovable proposition: *)

Check (forall (n:nat), n = 2).
(* ===> Prop *)

(** Recall that [Check] asks Coq to tell us the type of the indicated
  expression. *)

(* ########################################################### *)
(** * Proofs and Evidence *)

(** In Coq, propositions have the same status as other types, such as
    [nat].  Just as the natural numbers [0], [1], [2], etc. inhabit
    the type [nat], a Coq proposition [P] is inhabited by its
    _proofs_.  We will refer to such inhabitants as _proof term_ or
    _proof object_ or _evidence_ for the truth of [P].

    In Coq, when we state and then prove a lemma such as:

Lemma silly : 0 * 3 = 0.
Proof. reflexivity. Qed.

    the tactics we use within the [Proof]...[Qed] keywords tell Coq
    how to construct a proof term that inhabits the proposition.  In
    this case, the proposition [0 * 3 = 0] is justified by a
    combination of the _definition_ of [mult], which says that [0 * 3]
    _simplifies_ to just [0], and the _reflexive_ principle of
    equality, which says that [0 = 0].

*)

(** *** *)

Lemma silly : 0 * 3 = 0.
Proof. reflexivity. Qed.

(** We can see which proof term Coq constructs for a given Lemma by
using the [Print] directive: *)

Print silly.
(* ===> silly = eq_refl : 0 * 3 = 0 *)

(** Here, the [eq_refl] proof term witnesses the equality. (More on equality later!)*)

(** ** Implications _are_ functions *)

(** Just as we can implement natural number multiplication as a
function:

[
mult : nat -> nat -> nat
]

The _proof term_ for an implication [P -> Q] is a _function_ that takes evidence for [P] as input and produces evidence for [Q] as its output.
*)

Lemma silly_implication : (1 + 1) = 2  ->  0 * 3 = 0.
Proof. intros H. reflexivity. Qed.

(** We can see that the proof term for the above lemma is indeed a
function: *)

Print silly_implication.
(* ===> silly_implication = fun _ : 1 + 1 = 2 => eq_refl
     : 1 + 1 = 2 -> 0 * 3 = 0 *)

(** ** Defining Propositions *)

(** Just as we can create user-defined inductive types (like the
    lists, binary representations of natural numbers, etc., that we
    seen before), we can also create _user-defined_ propositions.

    Question: How do you define the meaning of a proposition?
*)

(** *** *)

(** The meaning of a proposition is given by _rules_ and _definitions_
    that say how to construct _evidence_ for the truth of the
    proposition from other evidence.

    - Typically, rules are defined _inductively_, just like any other datatype.

    - Sometimes a proposition is declared to be true without substantiating evidence.  Such propositions are called _axioms_.

    In this, and subsequence chapters, we'll see more about how these
    proof terms work in more detail.
*)

(* ########################################################### *)
(** * Conjunction (Logical "and") *)

(** The logical conjunction of propositions [P] and [Q] can be
    represented using an [Inductive] definition with one
    constructor. *)

Inductive and (P Q : Prop) : Prop :=
  conj : P -> Q -> (and P Q).

(** The intuition behind this definition is simple: to
    construct evidence for [and P Q], we must provide evidence
    for [P] and evidence for [Q].  More precisely:

    - [conj p q] can be taken as evidence for [and P Q] if [p]
      is evidence for [P] and [q] is evidence for [Q]; and

    - this is the _only_ way to give evidence for [and P Q] --
      that is, if someone gives us evidence for [and P Q], we
      know it must have the form [conj p q], where [p] is
      evidence for [P] and [q] is evidence for [Q].

   Since we'll be using conjunction a lot, let's introduce a more
   familiar-looking infix notation for it. *)

Notation "P /\ Q" := (and P Q) : type_scope.

(** (The [type_scope] annotation tells Coq that this notation
    will be appearing in propositions, not values.) *)

(** Consider the "type" of the constructor [conj]: *)

Check conj.
(* ===>  forall P Q : Prop, P -> Q -> P /\ Q *)

(** Notice that it takes 4 inputs -- namely the propositions [P]
    and [Q] and evidence for [P] and [Q] -- and returns as output the
    evidence of [P /\ Q]. *)

(** ** "Introducing" Conjuctions *)
(** Besides the elegance of building everything up from a tiny
    foundation, what's nice about defining conjunction this way is
    that we can prove statements involving conjunction using the
    tactics that we already know.  For example, if the goal statement
    is a conjuction, we can prove it by applying the single
    constructor [conj], which (as can be seen from the type of [conj])
    solves the current goal and leaves the two parts of the
    conjunction as subgoals to be proved separately. *)

Theorem and_example :
  (0 = 0) /\ (4 = mult 2 2).
Proof.
  apply conj.
  Case "left". reflexivity.
  Case "right". reflexivity.  Qed.

(** Just for convenience, we can use the tactic [split] as a shorthand for
    [apply conj]. *)

Theorem and_example' :
  (0 = 0) /\ (4 = mult 2 2).
Proof.
  split.
    Case "left". reflexivity.
    Case "right". reflexivity.  Qed.

(** ** "Eliminating" conjunctions *)
(** Conversely, the [inversion] tactic can be used to take a
    conjunction hypothesis in the context, calculate what evidence
    must have been used to build it, and add variables representing
    this evidence to the proof context. *)

Theorem proj1 : forall P Q : Prop,
  P /\ Q -> P.
Proof.
  intros P Q H.
  inversion H as [HP HQ].
  apply HP.  Qed.

(** **** Exercise: 1 star, optional (proj2) *)
Theorem proj2 : forall P Q : Prop,
  P /\ Q -> Q.
Proof.
  intros P Q H. inversion H as [HP HQ]. apply HQ. Qed.
(** [] *)

Theorem and_commut : forall P Q : Prop,
  P /\ Q -> Q /\ P.
Proof.
  (* WORKED IN CLASS *)
  intros P Q H.
  inversion H as [HP HQ].
  split.
    Case "left". apply HQ.
    Case "right". apply HP.  Qed.

(** **** Exercise: 2 stars (and_assoc) *)
(** In the following proof, notice how the _nested pattern_ in the
    [inversion] breaks the hypothesis [H : P /\ (Q /\ R)] down into
    [HP: P], [HQ : Q], and [HR : R].  Finish the proof from there: *)

Theorem and_assoc : forall P Q R : Prop,
  P /\ (Q /\ R) -> (P /\ Q) /\ R.
Proof.
  intros P Q R H.
  inversion H as [HP [HQ HR]].
  split.
  - Case "left". split.
    + apply HP.
    + apply HQ.
  - Case "right". apply HR.
Qed.
(** [] *)

(* ###################################################### *)
(** * Iff *)

(** The handy "if and only if" connective is just the conjunction of
    two implications. *)

Definition iff (P Q : Prop) := (P -> Q) /\ (Q -> P).

Notation "P <-> Q" := (iff P Q)
                      (at level 95, no associativity)
                      : type_scope.

Theorem iff_implies : forall P Q : Prop,
  (P <-> Q) -> P -> Q.
Proof.
  intros P Q H.
  inversion H as [HAB HBA]. apply HAB.  Qed.

Theorem iff_sym : forall P Q : Prop,
  (P <-> Q) -> (Q <-> P).
Proof.
  (* WORKED IN CLASS *)
  intros P Q H.
  inversion H as [HAB HBA].
  split.
    Case "->". apply HBA.
    Case "<-". apply HAB.  Qed.

(** **** Exercise: 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. *)

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

Theorem iff_trans : forall P Q R : Prop,
  (P <-> Q) -> (Q <-> R) -> (P <-> R).
Proof.
  intros P Q R H I.
  destruct H as [H0 H1].
  destruct I as [H2 H3].
  split.
  - intros X. apply H2. apply H0. apply X.
  - intros X. apply H1. apply H3. apply X.
Qed.

(** 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.) *)
(** [] *)

(** Some of Coq's tactics treat [iff] statements specially, thus
    avoiding the need for some low-level manipulation when reasoning
    with them.  In particular, [rewrite] can be used with [iff]
    statements, not just equalities. *)

(* ############################################################ *)
(** * Disjunction (Logical "or") *)

(** ** Implementing Disjunction *)

(** Disjunction ("logical or") can also be defined as an
    inductive proposition. *)

Inductive or (P Q : Prop) : Prop :=
  | or_introl : P -> or P Q
  | or_intror : Q -> or P Q.

Notation "P \/ Q" := (or P Q) : type_scope.

(** Consider the "type" of the constructor [or_introl]: *)

Check or_introl.
(* ===>  forall P Q : Prop, P -> P \/ Q *)

(** It takes 3 inputs, namely the propositions [P], [Q] and
    evidence of [P], and returns, as output, the evidence of [P \/ Q].
    Next, look at the type of [or_intror]: *)

Check or_intror.
(* ===>  forall P Q : Prop, Q -> P \/ Q *)

(** It is like [or_introl] but it requires evidence of [Q]
    instead of evidence of [P]. *)

(** Intuitively, there are two ways of giving evidence for [P \/ Q]:

    - give evidence for [P] (and say that it is [P] you are giving
      evidence for -- this is the function of the [or_introl]
      constructor), or

    - give evidence for [Q], tagged with the [or_intror]
      constructor. *)

(** *** *)
(** Since [P \/ Q] has two constructors, doing [inversion] on a
    hypothesis of type [P \/ Q] yields two subgoals. *)

Theorem or_commut : forall P Q : Prop,
  P \/ Q  -> Q \/ P.
Proof.
  intros P Q H.
  destruct H as [HP | HQ].
    Case "left". apply or_intror. apply HP.
    Case "right". apply or_introl. apply HQ.  Qed.

(** From here on, we'll use the shorthand tactics [left] and [right]
    in place of [apply or_introl] and [apply or_intror]. *)

Theorem or_commut' : forall P Q : Prop,
  P \/ Q  -> Q \/ P.
Proof.
  intros P Q H.
  inversion H as [HP | HQ].
    Case "left". right. apply HP.
    Case "right". left. apply HQ.  Qed.

Theorem or_distributes_over_and_1 : forall P Q R : Prop,
  P \/ (Q /\ R) -> (P \/ Q) /\ (P \/ R).
Proof.
  intros P Q R. intros H. inversion H as [HP | [HQ HR]].
    Case "left". split.
      SCase "left". left. apply HP.
      SCase "right". left. apply HP.
    Case "right". split.
      SCase "left". right. apply HQ.
      SCase "right". right. apply HR.  Qed.

(** **** Exercise: 2 stars (or_distributes_over_and_2) *)
Theorem or_distributes_over_and_2 : forall P Q R : Prop,
  (P \/ Q) /\ (P \/ R) -> P \/ (Q /\ R).
Proof.
  intros P Q R H.
  destruct H.
  destruct H0.
  - left. apply H0.
  - destruct H.
    + left. apply H.
    + right. split. apply H. apply H0.
Qed.

(** [] *)

(** **** Exercise: 1 star, optional (or_distributes_over_and) *)
Theorem or_distributes_over_and : forall P Q R : Prop,
  P \/ (Q /\ R) <-> (P \/ Q) /\ (P \/ R).
Proof.
  split. apply or_distributes_over_and_1. apply or_distributes_over_and_2.
Qed.
(** [] *)

(* ################################################### *)
(** ** Relating [/\] and [\/] with [andb] and [orb] (advanced) *)

(** We've already seen several places where analogous structures
    can be found in Coq's computational ([Type]) and logical ([Prop])
    worlds.  Here is one more: the boolean operators [andb] and [orb]
    are clearly analogs of the logical connectives [/\] and [\/].
    This analogy can be made more precise by the following theorems,
    which show how to translate knowledge about [andb] and [orb]'s
    behaviors on certain inputs into propositional facts about those
    inputs. *)

Theorem andb_prop : forall b c,
  andb b c = true -> b = true /\ c = true.
Proof.
  (* WORKED IN CLASS *)
  intros b c H.
  destruct b.
    Case "b = true". destruct c.
      SCase "c = true". apply conj. reflexivity. reflexivity.
      SCase "c = false". inversion H.
    Case "b = false". inversion H.  Qed.

Theorem andb_true_intro : forall b c,
  b = true /\ c = true -> andb b c = true.
Proof.
  (* WORKED IN CLASS *)
  intros b c H.
  inversion H.
  rewrite H0. rewrite H1. reflexivity. Qed.

(** **** Exercise: 2 stars, optional (bool_prop) *)
Theorem andb_false : forall b c,
  andb b c = false -> b = false \/ c = false.
Proof.
  intros. destruct b.
  - simpl in H. right. apply H.
  - left. reflexivity.
Qed.

Theorem orb_prop : forall b c,
  orb b c = true -> b = true \/ c = true.
Proof.
  intros. destruct b.
  - left. reflexivity.
  - simpl in H. right. apply H.
Qed.

Theorem orb_false_elim : forall b c,
  orb b c = false -> b = false /\ c = false.
Proof.
  intros. destruct b.
  - inversion H.
  - split. reflexivity. apply H.
Qed.
(** [] *)

(* ################################################### *)
(** * Falsehood *)

(** Logical falsehood can be represented in Coq as an inductively
    defined proposition with no constructors. *)

Inductive False : Prop := .

(** Intuition: [False] is a proposition for which there is no way
    to give evidence. *)

(** Since [False] has no constructors, inverting an assumption
    of type [False] always yields zero subgoals, allowing us to
    immediately prove any goal. *)

Theorem False_implies_nonsense :
  False -> 2 + 2 = 5.
Proof.
  intros contra.
  destruct contra.  Qed.

(** How does this work? The [inversion] tactic breaks [contra] into
    each of its possible cases, and yields a subgoal for each case.
    As [contra] is evidence for [False], it has _no_ possible cases,
    hence, there are no possible subgoals and the proof is done. *)

(** *** *)
(** Conversely, the only way to prove [False] is if there is already
    something nonsensical or contradictory in the context: *)

Theorem nonsense_implies_False :
  2 + 2 = 5 -> False.
Proof.
  intros contra.
  inversion contra.  Qed.

(** Actually, since the proof of [False_implies_nonsense]
    doesn't actually have anything to do with the specific nonsensical
    thing being proved; it can easily be generalized to work for an
    arbitrary [P]: *)

Theorem ex_falso_quodlibet : forall (P:Prop),
  False -> P.
Proof.
  (* WORKED IN CLASS *)
  intros P contra.
  inversion contra.  Qed.

(** The Latin _ex falso quodlibet_ means, literally, "from
    falsehood follows whatever you please."  This theorem is also
    known as the _principle of explosion_. *)

(* #################################################### *)
(** ** Truth *)

(** Since we have defined falsehood in Coq, one might wonder whether
    it is possible to define truth in the same way.  We can. *)

(** **** Exercise: 2 stars, advanced (True) *)
(** Define [True] as another inductively defined proposition.  (The
    intution is that [True] should be a proposition for which it is
    trivial to give evidence.) *)

Inductive True := PTrue.
(** [] *)

(** However, unlike [False], which we'll use extensively, [True] is
    used fairly rarely. By itself, it is trivial (and therefore
    uninteresting) to prove as a goal, and it carries no useful
    information as a hypothesis. But it can be useful when defining
    complex [Prop]s using conditionals, or as a parameter to
    higher-order [Prop]s. *)

(* #################################################### *)
(** * Negation *)

(** The logical complement of a proposition [P] is written [not
    P] or, for shorthand, [~P]: *)

Definition not (P:Prop) := P -> False.

(** The intuition is that, if [P] is not true, then anything at
    all (even [False]) follows from assuming [P]. *)

Notation "~ x" := (not x) : type_scope.

Check not.
(* ===> Prop -> Prop *)

(** It takes a little practice to get used to working with
    negation in Coq.  Even though you can see perfectly well why
    something is true, it can be a little hard at first to get things
    into the right configuration so that Coq can see it!  Here are
    proofs of a few familiar facts about negation to get you warmed
    up. *)

Theorem not_False :
  ~ False.
Proof.
  unfold not. intros H. inversion H.  Qed.

(** *** *)
Theorem contradiction_implies_anything : forall P Q : Prop,
  (P /\ ~P) -> Q.
Proof.
  (* WORKED IN CLASS *)
  intros P Q H. inversion H as [HP HNA]. unfold not in HNA.
  apply HNA in HP. inversion HP.  Qed.

Theorem double_neg : forall P : Prop,
  P -> ~~P.
Proof.
  (* WORKED IN CLASS *)
  intros P H. unfold not. intros G. apply G. apply H.  Qed.

(** **** Exercise: 2 stars, advanced (double_neg_inf) *)
(** Write an informal proof of [double_neg]:

   _Theorem_: [P] implies [~~P], for any proposition [P].

   _Proof_:
(* FILL IN HERE *)
   []
*)

(** **** Exercise: 2 stars (contrapositive) *)
Theorem contrapositive : forall P Q : Prop,
  (P -> Q) -> (~Q -> ~P).
Proof.
  intros P Q H G.
  unfold not in G. unfold not.
  intro F. apply G. apply H. apply F.
Qed.
(** [] *)

(** **** Exercise: 1 star (not_both_true_and_false) *)
Theorem not_both_true_and_false : forall P : Prop,
  ~ (P /\ ~P).
Proof.
  intros. unfold not. intros. destruct H.
  apply H0. apply H.
Qed.
(** [] *)

(** **** Exercise: 1 star, advanced (informal_not_PNP) *)
(** Write an informal proof (in English) of the proposition [forall P
    : Prop, ~(P /\ ~P)]. *)

(* FILL IN HERE *)
(** [] *)

(** *** Constructive logic *)
(** Note that some theorems that are true in classical logic are _not_
    provable in Coq's (constructive) logic.  E.g., let's look at how
    this proof gets stuck... *)

Theorem classic_double_neg : forall P : Prop,
  ~~P -> P.
Proof.
  (* WORKED IN CLASS *)
  intros P H. unfold not in H.
  (* But now what? There is no way to "invent" evidence for [~P]
     from evidence for [P]. *)
  Abort.

(** **** Exercise: 5 stars, advanced, optional (classical_axioms) *)
(** For those who like a challenge, here is an exercise
    taken from the Coq'Art book (p. 123).  The following five
    statements are often considered as characterizations of
    classical logic (as opposed to constructive logic, which is
    what is "built in" to Coq).  We can't prove them in Coq, but
    we can consistently add any one of them as an unproven axiom
    if we wish to work in classical logic.  Prove that these five
    propositions are equivalent. *)

Definition peirce := forall P Q: Prop,
  ((P->Q)->P)->P.
Definition classic := forall P:Prop,
  ~~P -> P.
Definition excluded_middle := forall P:Prop,
  P \/ ~P.
Definition de_morgan_not_and_not := forall P Q:Prop,
  ~(~P /\ ~Q) -> P\/Q.
Definition implies_to_or :=
  forall P Q:Prop,
    (P->Q) -> (~P\/Q).

Theorem pierce_classic : peirce -> classic.
Proof.
  intros. unfold peirce in H.
  unfold classic. intros.
  unfold not in H0. apply H with False. intros. apply H0 in H1. destruct H1.
Qed.

Theorem classic_excluded_middle : classic -> excluded_middle.
Proof.
  unfold classic. unfold excluded_middle. intros.
  apply H. unfold not. intros. apply H0. right. intros.
  apply H0. left. apply H1.
Qed.

Theorem excluded_middle_de_morgan : excluded_middle -> de_morgan_not_and_not.
Proof.
  unfold excluded_middle. unfold de_morgan_not_and_not. intros.
  unfold not in H0. destruct (H P).
  - left. apply H1.
  - right. destruct (H Q).
    + apply H2.
    + destruct H0. split. apply H1. apply H2.
Qed.

Theorem de_morgan_not_implies_to_or : de_morgan_not_and_not -> implies_to_or.
Proof.
  unfold de_morgan_not_and_not. unfold implies_to_or. intros.
  destruct (H (~P) Q).
  - unfold not. intros. destruct H1. apply contrapositive in H0.
    + apply H1. apply H0.
    + unfold not. apply H2.
  - left. apply H1.
  - right. apply H1.
Qed.

Theorem implies_to_or_peirce : implies_to_or -> peirce.
Proof.
  unfold implies_to_or. unfold peirce. intros H. intros.
  destruct (H P P).
  - intros X. apply X.
  - apply H0. intros. destruct H1. apply H2.
  - apply H1.
Qed.

(** [] *)

(** **** Exercise: 3 stars (excluded_middle_irrefutable) *)
(** This theorem implies that it is always safe to add a decidability
axiom (i.e. an instance of excluded middle) for any _particular_ Prop [P].
Why? Because we cannot prove the negation of such an axiom; if we could,
we would have both [~ (P \/ ~P)] and [~ ~ (P \/ ~P)], a contradiction. *)

Theorem excluded_middle_irrefutable:  forall (P:Prop), ~ ~ (P \/ ~ P).
Proof.
  intros. unfold not. intros.
  apply H. right. intros. apply H. left. apply H0.
Qed.

(* ########################################################## *)
(** ** Inequality *)

(** Saying [x <> y] is just the same as saying [~(x = y)]. *)

Notation "x <> y" := (~ (x = y)) : type_scope.

(** Since inequality involves a negation, it again requires
    a little practice to be able to work with it fluently.  Here
    is one very useful trick.  If you are trying to prove a goal
    that is nonsensical (e.g., the goal state is [false = true]),
    apply the lemma [ex_falso_quodlibet] to change the goal to
    [False].  This makes it easier to use assumptions of the form
    [~P] that are available in the context -- in particular,
    assumptions of the form [x<>y]. *)

Theorem not_false_then_true : forall b : bool,
  b <> false -> b = true.
Proof.
  intros b H. destruct b.
  Case "b = true". reflexivity.
  Case "b = false".
    unfold not in H.
    apply ex_falso_quodlibet.
    apply H. reflexivity.   Qed.

(** *** *)

(** *** *)

(** *** *)

(** *** *)

(** *** *)

(** **** Exercise: 2 stars (false_beq_nat) *)
Theorem false_beq_nat : forall n m : nat,
     n <> m ->
     beq_nat n m = false.
Proof.
  intro n.
  induction n as [|n'].
  - destruct m. intros. destruct H. reflexivity. reflexivity.
  - destruct m. reflexivity. intros. simpl. unfold not in H.
    apply IHn'. unfold not. intros. apply H. rewrite H0. reflexivity.
Qed.
(** [] *)

(** **** Exercise: 2 stars, optional (beq_nat_false) *)
Theorem beq_nat_false : forall n m,
  beq_nat n m = false -> n <> m.
Proof.
  unfold not. intros. rewrite H0 in H. rewrite <- beq_nat_refl in H.
  inversion H.
Qed.

(** [] *)

(* $Date: 2014-06-05 07:22:21 -0400 (Thu, 05 Jun 2014) $ *)


Require Export ZArith.
Require Export ZArithRing.
Require Export Zcompare.
Require Export Zwf.
Open Scope Z_scope.

Definition factZ_it_F (fact : Z ->  Z) (x : Z) :=
   match Z_lt_le_dec x 0 with
     left h => 0
    | right h =>
        match Z_eq_dec 0 x with   left h' => 1
                                 | right h'' => x * fact (x - 1) end
   end.

Fixpoint iter {A : Type} (f : A ->  A) (k : nat) (a : A) {struct k} : A :=
 match k with   0%nat => a
               | S p => f (iter f p a) end.

Definition factZ_terminates:
 forall (x : Z),
  ({v : Z |
   exists p : nat ,
   forall k, forall g, (p < k)%nat ->  iter factZ_it_F k g x = v }).
Proof.
 induction  x as [x IHx] using (well_founded_induction (Zwf_well_founded 0)).
 unfold factZ_it_F;case_eq (Z_lt_le_dec x 0).
 - intros h heq1; exists 0, 1%nat.
   intros k; case k.
   + intros; omega.
   + intros; simpl; rewrite heq1; auto.
 - intros h heq2; case_eq (Z_eq_dec 0 x).
   + intros h' heq3; exists 1, 1%nat.
   intros k; case k.
     * intros; omega.
     * intros; simpl; rewrite heq2;  simpl in heq3; rewrite heq3; auto.
   + intros h'' heq4; assert (HZwf: Zwf 0 (x - 1) x).
     * clear heq2 heq4; unfold Zwf; omega.
      * destruct (IHx (x - 1) HZwf) as [v Hex]; exists (x * v).
        destruct Hex as [p Heq]; exists (S p); intros k; case k.
         intros; omega.
         simpl; intros k' hltk g; rewrite heq2; simpl in heq4;rewrite heq4.
         fold factZ_it_F;  rewrite Heq; [reflexivity | omega].
Qed.

Definition factZ_it : Z ->  Z :=
   fun x =>
      match factZ_terminates x with exist _ v _ => v end.

Theorem factZ_fix_eqn:
 forall x,
  factZ_it x =
  match Z_lt_le_dec x 0 with
   | left h => 0
   | right h =>
       match Z_eq_dec 0 x with   left h' => 1
                                | right h'' => x * factZ_it (x - 1) end
  end.
 Proof.
  intros x; unfold factZ_it;
  destruct  (factZ_terminates x) as [v [p Heq]];
  destruct (factZ_terminates (x - 1)) as [v' [p' Heq']].
  rewrite <- (Heq (S ((p + p') + 1)) factZ_it).
  - simpl iter; unfold factZ_it_F.
    case (Z_lt_le_dec x 0); auto.
    case (Z_eq_dec 0 x); auto.
    rewrite <- (Heq' ((p + p') + 1)%nat factZ_it).
    +  reflexivity.
    +  omega.
  - omega.
Qed.


Require Import ZArith.
Require Import List.

Inductive bop: Set := Badd.
Inductive expr: Set :=
| e_cst: Z -> expr
| e_bin: bop -> expr -> expr -> expr.
Fixpoint expr_eval (e: expr): Z :=
match e with
| e_cst i => i
| e_bin Badd e1 e2 => Zplus (expr_eval e1) (expr_eval e2)
end.
Inductive inst: Set :=
| Ipush: Z -> inst
| Iadd: inst.
Fixpoint step (s: list Z) (i: inst): list Z :=
match s, i with
| _, Ipush z => z :: s
| v :: u :: t, Iadd => (Zplus v u) :: t
| _, ladd => nil
end.
Fixpoint fold_left (l: list inst) (s: list Z): list Z :=
match l with
| nil => s
| i :: t => fold_left t (step s i)
end.
Fixpoint exec (l: list inst): list Z :=
match (fold_left l nil) with
| v :: nil => v :: nil
| _ => nil
end.
Fixpoint compile (e: expr): list inst :=
match e with
| e_cst i => (Ipush i) :: nil
| e_bin Badd e1 e2 => (compile e1) ++ (compile e2) ++ (Iadd :: nil)
end.

Lemma partial_exec : forall e: expr, forall l1: list inst, forall l2: list Z, fold_left ((compile e) ++ l1) l2 = fold_left l1 ((expr_eval e) :: l2).
Proof.
intros.
induction e.
simpl.

Lemma eq_eval_exec_compile_offset : forall l: list Z, forall e: expr, (expr_eval e) :: l = (fold_left (compile e) nil) ++ l.
Proof.
intros.
induction e.
simpl.
trivial.
induction b.
simpl.

Theorem eq_eval_exec_compile: forall e: expr, (expr_eval e) :: nil = exec (compile e).
Proof.


(************************************************************************)
(* Copyright 2007 Milad Niqui                                           *)
(* This file is distributed under the terms of the                      *)
(* GNU Lesser General Public License Version 2.1                        *)
(* A copy of the license can be found at                                *)
(*                  <http://www.gnu.org/licenses/lgpl.txt>              *)
(************************************************************************)

Require Import Arith Omega.

Require OrderedTypeEx.
Require FSetList.
Module NatSet := FSetList.Make(OrderedTypeEx.Nat_as_OT).
Import NatSet.

Infix "++" := add (at level 60, right associativity).
Notation "s [=] t" := (Equal s t) (at level 70, no associativity).

Require FSetFacts FSetProperties.
Require Extraction.

Module GeneralProperties := FSetProperties.Properties NatSet.
Import GeneralProperties.

Section problem_knows_not_refl.

Variable town: t.
Variable n:nat.
Variable cardinality: cardinal town = 2*n+1.

Variable knows: elt -> elt -> Prop.

Variable knows_sym: forall m n, knows m n ->  knows n m.
Variable knows_extensional:forall m n p, E.eq n p -> knows m n-> knows m p.

Variable property: forall B, Subset B town -> cardinal B = n ->
           {d:elt | In d (diff town B)/\(forall b, In b B -> knows d b)}.

Lemma extendible_by_one:forall B', cardinal B' <= (cardinal town)-1 -> {d:elt| In d town /\ ~(In d B')}.
Proof.
 clear knows knows_sym knows_extensional property.
 intros B' H_cardinal_town.
 assert (H_town:1<=(cardinal town)); [omega|].
 rewrite <- (diff_inter_cardinal town B') in H_cardinal_town.
 rewrite <- (diff_inter_cardinal town B') in H_town.
 assert (H_inter:cardinal (inter town B') <= cardinal B');
  [apply (subset_cardinal);apply (inter_subset_2)|].
 generalize (le_trans _ _ _ H_inter H_cardinal_town); intro H1.
 assert (H2:1<=cardinal (diff town B')); [omega|].
 assert (H3:=(S_pred _ _ H2)).
 destruct (cardinal_inv_2 H3) as [d Hd].
 exists d; split.
  apply diff_1 with B'; assumption.
  apply diff_2 with town; assumption.
Qed.

Lemma extendible_to_n:forall B', Subset B' town -> cardinal B' <= n ->
     {B:t| cardinal B = n /\  Subset B' B /\ Subset B town}.
Proof.
 intros B' H_sub H_B'_cardinal.
 assert (H_cardinal_aux_3:2*n<=(cardinal town)-1);[apply le_trans with (2*n); omega|].
 clear property.
 induction n in H_B'_cardinal, H_cardinal_aux_3 |- *.
 (* n = 0 *)
 generalize (sym_eq (le_n_O_eq _ H_B'_cardinal)); intro H_eq.
 generalize (empty_is_empty_1 (cardinal_inv_1 H_eq)).
 intro H_B'.
 exists empty; repeat split.
  rewrite H_B'; apply subset_empty.
  apply subset_empty.
 (* n = S n0 *)
 destruct (le_lt_eq_dec _ _ H_B'_cardinal) as [H_lt|H_le].
  generalize (lt_n_Sm_le _ _ H_lt); clear H_lt; intro H_le.
  assert (H_cardinal_town_2:2 * n0 <= cardinal town - 1);[omega|].
  destruct (IHn0 H_le H_cardinal_town_2) as [C [HC1 [HC2 HC3]]].
  assert (HC5:cardinal C <= cardinal town - 1).
   rewrite HC1; apply le_trans with (2*(S n0));[omega| assumption].
  destruct (extendible_by_one C HC5) as [d [Hd1 Hd2]].
  exists (d ++ C).
  repeat split.
   rewrite (add_cardinal_2 Hd2); rewrite HC1; reflexivity.
   apply subset_add_2; assumption.
   apply subset_add_3; assumption.

  exists B'.
  repeat split; trivial; apply subset_refl.
Qed.

(** The following property, proven by induction, is the heart of the
solution, and is due to Tonny Hurkens. *)
Lemma inductive_invariant:forall m, m<= n ->
   {B':t| Subset B' town /\ cardinal B' = m /\ forall b'0 b'1, In b'0 B' -> In b'1 B' -> ~(E.eq b'0 b'1) -> knows b'0 b'1}.
Proof.
 intros m.
 induction m; intros H_le.
  (* 0 *)
  exists empty.
  repeat split.
   apply subset_empty.
   intros b'0 b'1 H0 H1; apply False_ind.
   elim (FM.empty_iff b'0); intros H2 _; apply H2; assumption.
  (* S n *)
  assert (H_le0:=le_Sn_le _ _ H_le).
  destruct (IHm H_le0) as [B' [H3' [H1 H2]]].
  rewrite <- H1 in H_le0.
  destruct (extendible_to_n B' H3' H_le0) as [B [HB1 [HB2 HB3]]].
  destruct (property B HB3 HB1) as [d [Hd1 Hd2]].
  exists (add d B'); repeat split.
   (* subset of town *)
   apply subset_add_3.
   apply diff_1 with B; assumption.
   apply subset_trans with B; assumption.
   (* cardinality *)
   rewrite <- H1.
   apply add_cardinal_2.
   intro Hd4.
   generalize (in_subset Hd4 HB2).
   apply diff_2 with town; assumption.
(* second big goal *)
   intros b'0 b'1 H_b'0 H_b'1 H_neq.
   destruct ((proj1 (FM.add_iff B' d b'0)) H_b'0) as [H3|H3].
    apply knows_sym; apply knows_extensional with d; trivial.
    destruct ((proj1 (FM.add_iff B' d b'1)) H_b'1) as [H4|H4].
     apply False_ind; apply H_neq; rewrite <- H3; assumption.
     apply knows_sym.
     apply Hd2; apply in_subset with B'; trivial.
    destruct ((proj1 (FM.add_iff B' d b'1)) H_b'1) as [H4|H4].
     apply knows_extensional with d; trivial.
     apply knows_sym.
     apply Hd2; apply in_subset with B'; trivial.
     apply H2; assumption.
Qed.

Theorem AMM11262: {e:elt | In e town /\ forall u, In u town /\ ~(E.eq u e)-> knows e u}.
Proof.
 destruct (inductive_invariant n (le_refl n)) as [B [HB1 [HB2 HB3]]].
 destruct (property B HB1 HB2) as [d [Hd1 Hd2]].
 set (C:=(diff town (d ++ B))).
 (* C subset town *)
 assert (H_susbset_C:Subset C town);
 [ subst C; apply subset_diff; apply subset_refl
 | ].
 (* inter town *)
 assert (H_inter_town: inter town (d ++ B)[=]d ++ B).
  rewrite inter_sym; apply inter_subset_equal;
  apply subset_add_3; trivial; apply diff_1 with B; assumption.
 (* ~ In d B *)
 assert (H_d_nin_B:~In d B); [apply diff_2 with town; assumption|].
 (* cardinal C = n *)
 assert (H_cardinal_C:cardinal C=n).
  assert (H_aux:cardinal (inter town (d ++ B))=S n).
   rewrite (@Equal_cardinal (inter town (d ++ B)) (d++B) H_inter_town);
   rewrite (add_cardinal_2 H_d_nin_B); rewrite HB2; reflexivity.
  generalize (diff_inter_cardinal town (d++B));
  fold C; rewrite H_aux; rewrite cardinality; omega.

 destruct (property C H_susbset_C H_cardinal_C) as [e [He1 He2]].
 exists e.
 (* Subset (d++B) town *)
 assert (H_dB_town:Subset (d++B) town).
  intros a Ha0; destruct ((proj1 (FM.add_iff B d a)) Ha0) as [Had|HaB].
   rewrite <- Had; apply diff_1 with B; assumption.
   apply HB1; assumption.
 (* diff town C = d++B *)
 assert (H_diff:diff town C [=] d++B ).
  unfold C; split; intro H_mem.
   (* => *)
   assert (H_a0:=diff_1 H_mem);
   assert (H_a1:=diff_2 H_mem);
   destruct (In_dec a (d++B)) as [H_a2|H_a2]; trivial;
   apply False_ind; apply H_a1; exact (diff_3 H_a0 H_a2).
   (* <= *)
   destruct (In_dec a (diff town (d++B))) as [H_a2|H_a2].
    apply False_ind; exact (diff_2 H_a2 H_mem).
    apply diff_3; trivial; apply H_dB_town; assumption.
 (* In e (d++B) *)
 assert (H_e_dB:In e (d++B)); [rewrite <- H_diff; assumption|].

 split.
  apply diff_1 with C; assumption...
  intros u [Hu Hu'].
  assert (H_town_part:town [=] (union C (d++B))).
   rewrite <- (diff_inter_all town (d++B)); rewrite H_inter_town; apply equal_refl.
   rewrite H_town_part in Hu.
   destruct (union_1 Hu) as [HuC|HudB].
    (* In u C *)
    apply He2; assumption.
    (* In u (d++B) *)
    destruct ((proj1 (FM.add_iff B d u)) HudB) as [Hud|HuB].
     (* d=u *)
     apply knows_extensional with d; trivial.
     apply knows_sym.
     destruct ((proj1 (FM.add_iff B d e)) H_e_dB) as [Hed|HeB].
      (* d=e *)
      apply False_ind; apply Hu'; rewrite <- Hud; assumption.
      (* In e B *)
      apply Hd2; assumption.
     (* In u B *)
     destruct ((proj1 (FM.add_iff B d e)) H_e_dB) as [Hed|HeB].
      (* d=e *)
      apply knows_sym; apply knows_extensional with d; trivial;
      apply knows_sym; apply Hd2; assumption.
      (* In e B *)
      apply HB3; assumption || contradict Hu'; auto with *.
Qed.

End problem_knows_not_refl.

Extraction "amm11262" AMM11262.


Require Import Arith.

Goal forall x y, x < y -> x + 10 < y + 10.
Proof.
  intros.
  apply plus_lt_compat_r.
  apply H.
Qed.