From LF Require Export induction.

Inductive natprod : Type :=
| pair (n1 n2 : nat).

Check (pair 3 5).

Definition fst (p : natprod) : nat :=
  match p with
  | pair x y => x
  end.

Definition snd (p : natprod) : nat :=
  match p with
  | pair x y => y
  end.

Compute (fst (pair 3 5)).

Notation "( x , y )" := (pair x y).

Theorem surjective_pairing' : forall (n m : nat),
  (n,m) = (fst (n,m), snd (n,m)).
Proof.
  reflexivity. Qed.

Theorem surjective_pairing_stuck : forall (p : natprod),
  p = (fst p, snd p).
Proof.
  simpl. Abort.

Theorem surjective_pairing : forall (p : natprod),
  p = (fst p, snd p).
Proof.
  intros p. destruct p as [n m]. simpl. reflexivity. Qed.

Definition swap_pair (p : natprod) : natprod :=
  match p with
  | (x,y) => (y,x)
  end.

Theorem snd_fst_is_swap : forall (p : natprod),
  (snd p, fst p) = swap_pair p.
Proof.
  intros p. destruct p as [n m]. simpl. reflexivity.
Qed.

Theorem fst_swap_is_snd : forall (p : natprod),
  fst (swap_pair p) = snd p.
Proof.
  intros p. destruct p as [n m]. simpl. reflexivity.
Qed.

Inductive natlist : Type :=
  | nil
  | cons (n : nat) (l : natlist).

Definition mylist := cons 1 (cons 2 (cons 3 nil)).

Notation "x :: l" := (cons x l)
                     (at level 60, right associativity).
Notation "[ ]" := nil.
Notation "[ x ; .. ; y ]" := (cons x .. (cons y nil) ..).

Fixpoint repeat (n count : nat) : natlist :=
  match count with
  | O => nil
  | S count' => n :: (repeat n count')
  end.

Fixpoint length (l:natlist) : nat :=
  match l with
  | nil => O
  | h :: t => S (length t)
  end.

Fixpoint app (l1 l2 : natlist) : natlist :=
  match l1 with
  | nil => l2
  | h :: t => h :: (app t l2)
  end.

Notation "x ++ y" := (app x y)
                     (right associativity, at level 60).

Example test_app1: [1;2;3] ++ [4;5] = [1;2;3;4;5].
Proof. reflexivity. Qed.
Example test_app2: nil ++ [4;5] = [4;5].
Proof. reflexivity. Qed.
Example test_app3: [1;2;3] ++ nil = [1;2;3].
Proof. reflexivity. Qed.

Definition hd (default:nat) (l:natlist) : nat :=
  match l with
  | nil => default
  | h :: t => h
  end.

Definition tl (l:natlist) : natlist :=
  match l with
  | nil => nil
  | h :: t => t
  end.

Example test_hd1: hd 0 [1;2;3] = 1.
Proof. reflexivity. Qed.
Example test_hd2: hd 0 [] = 0.
Proof. reflexivity. Qed.
Example test_tl: tl [1;2;3] = [2;3].
Proof. reflexivity. Qed.

Fixpoint nonzeros (l:natlist) : natlist :=
  match l with
  | nil => nil
  | h :: t => match h with
              | 0 => ([] ++ (nonzeros t))
              | _ => ([h]  ++ (nonzeros t))
              end
  end.

Example test_nonzeros:
  nonzeros [0;1;0;2;3;0;0] = [1;2;3].
Proof. reflexivity. Qed.

Fixpoint oddmembers (l:natlist) : natlist :=
  match l with
  | nil => nil
  | h :: t => match (evenb h) with
              | true => []  ++ (oddmembers t)
              | _    => h :: (oddmembers t)
              end
  end.

Example test_oddmembers:
  oddmembers [0;1;0;2;3;0;0] = [1;3].
Proof. reflexivity. Qed.

Definition countoddmembers (l:natlist) : nat :=
  match l with
  | nil => O
  | t   => length (oddmembers t)
end.

Example test_countoddmembers1:
  countoddmembers [1;0;3;1;4;5] = 4.
Proof. reflexivity. Qed.

Example test_countoddmembers2:
  countoddmembers [0;2;4] = 0.
Proof. reflexivity. Qed.

Example test_countoddmembers3:
  countoddmembers nil = 0.
Proof. reflexivity. Qed.

Fixpoint alternate (l1 l2 : natlist) : natlist :=
  match l1 with
  | nil => l2
  | h1 :: t1 => match l2 with
                | nil => l1
                | h2 :: t2 => [h1] ++ [h2] ++ (alternate t1 t2)
                end
end.

Example test_alternate1:
  alternate [1;2;3] [4;5;6] = [1;4;2;5;3;6].
Proof. reflexivity. Qed.

Example test_alternate2:
  alternate [1] [4;5;6] = [1;4;5;6].
Proof. reflexivity. Qed.

Example test_alternate3:
  alternate [1;2;3] [4] = [1;4;2;3].
Proof. reflexivity. Qed.

Example test_alternate4:
  alternate [] [20;30] = [20;30].
Proof. reflexivity. Qed.

Definition bag := natlist.

Fixpoint count (v:nat)(s:bag) :nat :=
  match s with
  | nil    => O
  | h :: t => match (eqb v h) with
              | true => S (count v t)
              | _ =>    count v t
              end
end.

Example test_count1: count 1 [1;2;3;1;4;1] = 3.
Proof. simpl. reflexivity. Qed.
Example test_count2: count 6 [1;2;3;1;4;1] = 0.
Proof. reflexivity. Qed.

Definition add (v:nat) (s:bag) : bag :=
  [v] ++ s.

Example test_add1: count 1 (add 1 [1;4;1]) = 3.
Proof. simpl. reflexivity. Qed.

Definition member (v:nat) (s:bag) : bool :=
  match (count v s) with
  | O => false
  | _ => true
end.

Example test_member1: member 1 [1;4;1] = true.
Proof. reflexivity. Qed.
Example test_member2: member 2 [1;4;1] = false.
Proof. reflexivity. Qed.

Definition nlist2bag (n:natlist) : bag :=
  n.

Fixpoint remove_one (v:nat) (s:bag) : bag :=
  match s with
  | nil    => []
  | h :: t => match (eqb v h) with
              | true => t
              | _ => h :: (remove_one v t)
              end
end.

Example test_remove_one1:
  count 5 (remove_one 5 [2;1;5;4;1]) = 0.
Proof. reflexivity. Qed.
Example test_remove_one2:
  count 5 (remove_one 5 [2;1;4;1]) = 0.
Proof. reflexivity. Qed.
Example test_remove_one3:
  count 4 (remove_one 5 [2;1;4;5;1;4]) = 2.
Proof. reflexivity. Qed.
Example test_remove_one4:
  count 5 (remove_one 5 [2;1;5;4;5;1;4]) = 1.
Proof. reflexivity. Qed.

Fixpoint remove_all (v:nat) (s:bag) : bag :=
  match s with
  | nil    => []
  | h :: t => match (eqb v h) with
              | true => remove_all v t
              | _ => h :: (remove_all v t)
              end
end.

Example test_remove_all1: count 5 (remove_all 5 [2;1;5;4;1]) = 0.
Proof. reflexivity. Qed.
Example test_remove_all2: count 5 (remove_all 5 [2;1;4;1]) = 0.
Proof. reflexivity. Qed.
Example test_remove_all3: count 4 (remove_all 5 [2;1;4;5;1;4]) = 2.
Proof. reflexivity. Qed.
Example test_remove_all4: count 5 (remove_all 5 [2;1;5;4;5;1;4;5;1;4]) = 0.
Proof. reflexivity. Qed.

Fixpoint subset (s1:bag) (s2:bag) : bool :=
  match s1 with
  | nil => true
  | h :: t => match (member h s2) with
              | true => subset t (remove_one h s2)
              | _ => false
              end
end.

Example test_subset1: subset [1;2] [2;1;4;1] = true.
Proof. reflexivity. Qed.
Example test_subset2: subset [1;2;2] [2;1;4;1] = false.
Proof. reflexivity. Qed.

Theorem eqb_nn : forall n:nat,
  eqb n n = true.
Proof.
 intros n. induction n. reflexivity.  simpl. rewrite IHn. reflexivity.
Qed.

Theorem nil_app : forall l:natlist,
  [] ++ l = l.
Proof.
   reflexivity. Qed.

Theorem tl_length_pred : forall l:natlist,
  pred (length l) = length (tl l).
Proof.
  intros l. destruct l as [| n l'].
  -
    reflexivity.
  -
    reflexivity. Qed.

Theorem app_assoc : forall l1 l2 l3 : natlist,
  (l1 ++ l2) ++ l3 = l1 ++ (l2 ++ l3).
Proof.
  intros l1 l2 l3. induction l1 as [| n l1' IHl1'].
  -
    reflexivity.
  -
    simpl. rewrite -> IHl1'. reflexivity. Qed.

Fixpoint rev (l:natlist) : natlist :=
  match l with
  | nil => nil
  | h :: t => rev t ++ [h]
  end.

Example test_rev1: rev [1;2;3] = [3;2;1].
Proof. reflexivity. Qed.
Example test_rev2: rev nil = nil.
Proof. reflexivity. Qed.

Theorem app_length : forall l1 l2 : natlist,
  length (l1 ++ l2) = (length l1) + (length l2).
Proof.
  intros l1 l2. induction l1 as [| n l1' IHl1'].
  -
    reflexivity.
  -
    simpl. rewrite -> IHl1'. reflexivity. Qed.

Theorem rev_length : forall l : natlist,
  length (rev l) = length l.
Proof.
  intros l. induction l as [| n l' IHl'].
  -
    reflexivity.
  -
    simpl. rewrite -> app_length. rewrite -> plus_comm.
    simpl. rewrite -> IHl'. reflexivity. Qed.

Theorem app_nil_r : forall l : natlist,
  l ++ [] = l.
Proof.
  intros l. induction l as [| n l' IHl'].
  - reflexivity.
  - simpl. rewrite IHl'. reflexivity.
Qed.

Theorem rev_app_distr: forall l1 l2 : natlist,
  rev (l1 ++ l2) = rev l2 ++ rev l1.
Proof.
  intros l1 l2. induction l1.
  - rewrite app_nil_r. reflexivity.
  - simpl. rewrite IHl1. rewrite app_assoc. reflexivity.
Qed.

Theorem rev_involutive : forall l : natlist,
  rev (rev l) = l.
Proof.
  intros l. induction l.
  - reflexivity.
  - simpl. rewrite rev_app_distr. simpl. rewrite -> IHl.
    reflexivity.
Qed.

Theorem app_nat : forall (n : nat) (l : natlist),
  n :: l = [n] ++ l.
Proof.
  intros n l. simpl. reflexivity.
Qed.

Theorem app_assoc4 : forall l1 l2 l3 l4 : natlist,
  l1 ++ (l2 ++ (l3 ++ l4)) = ((l1 ++ l2) ++ l3) ++ l4.
Proof.
  intros l1 l2 l3 l4.  rewrite app_assoc, app_assoc. reflexivity.
Qed.

Lemma nonzeros_app : forall l1 l2 : natlist,
  nonzeros (l1 ++ l2) = (nonzeros l1) ++ (nonzeros l2).
Proof.
  intros l1 l2. Search app. induction l1 as [ | n l' IHl].
  - reflexivity.
  - destruct n as [| n'].
    + simpl. rewrite IHl. reflexivity.
    + simpl. rewrite IHl. reflexivity.
Qed.

Fixpoint eqblist (l1 l2 : natlist) : bool :=
  match l1 with
  | nil => match l2 with
           | nil => true
           | _   => false
           end
  | h :: t => match l2 with
              | h1 :: t1 => match (eqb h h1) with
                            | true => eqblist t t1
                            | false => false
                            end
              | _ => false
              end
end.

Example test_eqblist1 :
  (eqblist nil nil = true).
Proof. reflexivity. Qed.

Example test_eqblist2 :
  eqblist [1;2;3] [1;2;3] = true.
Proof. reflexivity. Qed.

Example test_eqblist3 :
  eqblist [1;2;3] [1;2;4] = false.
Proof. reflexivity. Qed.

Theorem eqblist_refl : forall l:natlist,
  true = eqblist l l.
Proof.
  intros l. induction l.
  - reflexivity.
  -  simpl. rewrite IHl.
     induction n.
     + reflexivity.
     + rewrite <- eq_succ. rewrite <- IHn. reflexivity.
Qed.

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.

Theorem count_member_nonzero : forall (s : bag),
  leb 1  (count 1 (1 :: s)) = true.
Proof.
  intros s. reflexivity.
Qed.

Theorem leb_n_Sn : forall n,
  leb n (S n) = true.
Proof.
  intros n. induction n as [| n' IHn'].
  -
    simpl. reflexivity.
  -
    simpl. rewrite IHn'. reflexivity. Qed.

Theorem remove_does_not_increase_count: forall (s : bag),
  leb (count 0 (remove_one 0 s)) (count 0 s) = true.
Proof.
  intros s. induction s.
  - reflexivity.
  - destruct n.
    + simpl. rewrite leb_n_Sn. reflexivity.
    + simpl. rewrite IHs. reflexivity.
Qed.

Theorem rev_unit : forall (l1 l2 : natlist),
  rev l1 = rev l2 -> l1 = l2.
Proof.
  intros l1 l2 H. rewrite <- rev_involutive. rewrite <- H. rewrite rev_involutive.
  reflexivity.
Qed.

Inductive natoption : Type :=
  | Some (n : nat)
  | None.

Fixpoint nth_error (l:natlist) (n:nat) : natoption :=
  match l with
  | nil => None
  | a :: l' => match eqb n O with
               | true => Some a
               | false => nth_error l' (pred n)
               end
  end.

Example test_nth_error1 : nth_error [4;5;6;7] 0 = Some 4.
Proof. reflexivity. Qed.
Example test_nth_error2 : nth_error [4;5;6;7] 3 = Some 7.
Proof. reflexivity. Qed.
Example test_nth_error3 : nth_error [4;5;6;7] 9 = None.
Proof. reflexivity. Qed.

Fixpoint nth_error' (l:natlist) (n:nat) : natoption :=
  match l with
  | nil => None
  | a :: l' => if eqb n O then Some a
               else nth_error' l' (pred n)
  end.

Definition option_elim (d : nat) (o : natoption) : nat :=
  match o with
  | Some n' => n'
  | None => d
  end.

Definition hd_error (l : natlist) : natoption :=
  match l with
  | nil => None
  | h :: t => Some h
  end.

Example test_hd_error1 : hd_error [] = None.
Proof. reflexivity. Qed.

Example test_hd_error2 : hd_error [1] = Some 1.
Proof. reflexivity. Qed.

Example test_hd_error3 : hd_error [5;6] = Some 5.
Proof. reflexivity. Qed.

Theorem option_elim_hd : forall (l:natlist) (default:nat),
  hd default l = option_elim default (hd_error l).
Proof.
  intros l d. induction l.
  - reflexivity.
  - simpl. reflexivity.
Qed.

Notation "x == y" := (eqb x y)
                         (at level 70) : nat_scope.

Inductive id : Type :=
  | Id (n : nat).

Definition eqb_id (x1 x2 : id) :=
  match x1, x2 with
  | Id n1, Id n2 => n1 == n2
  end.

Theorem eqb_id_refl : forall x, true = eqb_id x x.
Proof.
  intros x. induction x.
  simpl. rewrite eqb_nn. reflexivity.
Qed.

Inductive partial_map : Type :=
  | empty
  | record (i : id) (v : nat) (m : partial_map).

Definition update (d : partial_map)
                  (x : id) (value : nat)
                  : partial_map :=
  record x value d.

Fixpoint find (x : id) (d : partial_map) : natoption :=
  match d with
  | empty => None
  | record y v d' => if eqb_id x y
                     then Some v
                     else find x d'
  end.

Theorem update_eq :
  forall (d : partial_map) (x : id) (v: nat),
    find x (update d x v) = Some v.
Proof.
  intros d x v. simpl. rewrite <- eqb_id_refl.
  reflexivity.
Qed.

Theorem update_neq :
  forall (d : partial_map) (x y : id) (o: nat),
    eqb_id x y = false -> find x (update d y o) = find x d.
Proof.
  intros d x y o H. simpl. rewrite -> H. reflexivity.
Qed.


Require Export D.

(********** Discussion and Variations **********)

Inductive ev_list {X:Type} : list X -> Prop :=
| el_nil: ev_list []
| el_cc : forall x y l, ev_list l -> ev_list (x::y::l)
.

Lemma ev_list__ev_length: forall X (l:list X),
  ev_list l -> ev (length l).
Proof. intros. induction H.
  Case "el_nil". simpl. apply ev_0.
  Case "el_cc". simpl. apply ev_SS. apply IHev_list.
Qed.

Lemma ev_length__ev_list: forall X n,
  ev n -> forall (l:list X), n = length l -> ev_list l.
Proof. intros X n H. induction H.
  Case "ev_0". destruct l.
    SCase "[]". intros. apply el_nil.
    SCase "x::l". intros. inversion H.
  Case "ev_SS". intros. destruct l.
    SCase "[]". apply el_nil. destruct l.
    SCase "[x]". inversion H0.
    SCase "x::x0::l". inversion H0. apply IHev in H2. apply el_cc. apply H2.
Qed.

Inductive pal {X:Type} : list X -> Prop :=
| pal_nil: pal []
| pal_sgl: forall (x:X), pal [x]
| pal_rcs: forall (x:X) (l:list X), pal l -> pal (x::(snoc l x)).

Theorem pal_app_rev : forall (X:Type) (l:list X), pal (l ++ (rev l)).
Proof.
  intros. induction l.
  Case "[]". simpl. apply pal_nil.
  Case "x::l". simpl. replace (x :: l ++ snoc (rev l) x) with (x :: snoc (l ++ rev l) x). apply pal_rcs. apply IHl.
    Lemma snoc_app_lem : forall (X:Type) (x:X) l1 l2, snoc (l1 ++ l2) x = l1 ++ snoc l2 x.
    Proof. intros. induction l1. reflexivity.
    simpl. rewrite IHl1. reflexivity. Qed.
  rewrite snoc_app_lem with (l2:=(rev l)). reflexivity.
Qed.

Theorem pal_rev : forall (X:Type) (l:list X), pal l -> l = rev l.
Proof. intros. induction H.
  Case "[]". reflexivity.
  Case "[x]". reflexivity.
  Case "x::l". simpl.
    Lemma x_snoc_lem : forall (X:Type) (x y:X) l,
      x :: snoc l y = snoc (x::l) y.
    Proof. intros. simpl. reflexivity. Qed.
    rewrite x_snoc_lem.
    Lemma snoc_rev_lem : forall (X:Type) (x:X) l,
       x :: (rev l)  = rev (snoc l x).
    Proof. intros.  induction l.
      Case "[]". simpl. reflexivity.
      Case "x0::l". simpl. rewrite<-IHl. simpl. reflexivity. Qed.
    assert (Hrev : x::l = x::(rev l)).
    Proof.  rewrite<-IHpal. reflexivity.
    rewrite -> Hrev. rewrite->snoc_rev_lem. reflexivity.
Qed.

Print le.

Definition lt (n m:nat) := le (S n) m.

Inductive square_of : nat -> nat -> Prop :=
  sq : forall n:nat, square_of n (n*n).

Theorem sq_3_9 : square_of 3 9.
Proof.
  apply sq. Qed.

Inductive next_nat : nat -> nat -> Prop :=
  nxt : forall n, next_nat n (S n).
Theorem next_2_3 : next_nat 2 3.
Proof. apply nxt. Qed.

Print ev.
Inductive next_even : nat -> nat -> Prop :=
| ne_1 : forall n, ev (S n) -> next_even n (S n)
| ne_2 : forall n, ev (S (S n)) -> next_even n (S (S n)).

Lemma le_trans : forall m n o,
  m <= n -> n <= o -> m <= o.
Proof. intros m n o Hmn Hno. induction Hno as [|n o].
  Case "le_n". apply Hmn.
  Case "le_S". apply le_S. apply IHHno. assumption. Qed.

Theorem test_le3:  2<=1 -> 2+2=5.
Proof. intro H. inversion H. inversion H2. Qed.

Theorem O_le_n : forall n, 0<=n.
Proof. intros. induction n as [|n']. apply le_n. apply le_S. assumption. Qed.

(*********************************************************)
Print le.
Theorem n_le_m__Sn_le_Sm: forall n m, S n <= S m -> n <= m.
Proof. intros. inversion H. apply le_n. apply le_trans with (m:=n) (n:=S n) (o:=m). apply le_S. apply le_n. apply H2.
Qed.

Theorem Sn_le_Sm__n_le_m: forall n m, n <= m -> S n <= S m.
Proof. intros. induction H. apply le_n. apply le_S. apply IHle. Qed.
(*********************************************************)

Lemma n_plus_O__n: forall n, n+0=n.
Proof. intros. induction n. reflexivity. simpl. rewrite->IHn. reflexivity. Qed.

Lemma a_Sb__S_a_b : forall a b, a + S b= S (a+b).
Proof. intros. induction a. reflexivity. simpl. rewrite IHa. reflexivity. Qed.

Lemma plus_comm: forall a b, a + b = b + a.
Proof. intros. induction a.
  Case "a". simpl. symmetry. apply n_plus_O__n.
  Case "S a". simpl. rewrite a_Sb__S_a_b. rewrite IHa. reflexivity. Qed.

Theorem le_plus_l: forall a b, a <= a + b.
Proof. intro a. induction a.
  Case "O". simpl. apply O_le_n.
  Case "S a". simpl. induction b.
    SCase "O". rewrite n_plus_O__n. apply le_n.
    SCase "S b". replace (a + S b) with (S (a + b)). apply le_S. apply IHb. symmetry. apply a_Sb__S_a_b. Qed.

Theorem plus_lt: forall n1 n2 m,
  n1 + n2 < m -> n1 < m /\ n2 < m.
Proof. intros n1 n2 m. unfold "<". split.
  Case "n1". apply le_trans with (m:=S n1) (n:= S(n1+n2)) (o:=m).
    replace (S (n1 + n2)) with (S n1 + n2). apply le_plus_l.
    simpl. reflexivity. apply H.
  Case "n2". apply le_trans with (m:=S n2) (n:=S (n1 + n2)) (o:= m). replace (S (n1 + n2)) with (S n2 + n1). apply le_plus_l. simpl. rewrite plus_comm.  reflexivity. apply H. Qed.

Theorem lt_S: forall n m, n < m -> n < S m.
Proof. intros n m. unfold "<". intro H. apply le_S. apply H. Qed.

Theorem ble_nat_true: forall n m,
  ble_nat n m = true -> n <= m.
Proof. intros. generalize dependent n. induction m.
  Case "O". induction n.
    SCase "O". intros. apply le_n.
    SCase "S n". intros. inversion H.
  Case "S m". intros. induction n.
    SCase "O". apply O_le_n.
    SCase "S n". inversion H. apply IHm in H1. apply Sn_le_Sm__n_le_m. assumption. Qed.

Theorem le_ble_nat: forall n m,
  n <= m -> ble_nat n m = true.
Proof. intro n. induction n.
  Case "O". intros. induction m.
    SCase "O". reflexivity.
    SCase "S m". reflexivity.
  Case "S n". intros. induction m.
    SCase "O". inversion H.
    SCase "S m". simpl. apply IHn. apply n_le_m__Sn_le_Sm.
    assumption. Qed.

Theorem ble_nat_true_trans: forall n m o,
  ble_nat n m = true -> ble_nat m o = true -> ble_nat n o = true.
Proof. intros. apply ble_nat_true in H. apply ble_nat_true in H0.
  apply le_ble_nat. apply le_trans with (m:=n) (n:=m). assumption. assumption. Qed.

Theorem ble_nat_false: forall n m,
  ble_nat n m = false -> ~(n<=m).
Proof. intros. unfold not. intro Hnm. apply le_ble_nat in Hnm. rewrite H in Hnm. inversion Hnm. Qed.

Inductive R : nat -> nat -> nat -> Prop :=
| c1 : R 0 0 0
| c2 : forall m n o, R m n o -> R (S m) n (S o)
| c3 : forall m n o, R m n o -> R m (S n) (S o)
| c4 : forall m n o, R (S m) (S n) (S (S o)) -> R m n o
| c5 : forall m n o, R m n o -> R n m o.

Theorem R112 : R 1 1 2.
Proof. apply c2. apply c3. apply c1. Qed.

(***************************************************)
Theorem R_mno :forall m n o,  R m n o -> m + n = o.
Proof. intros. generalize dependent n. generalize dependent m. induction o.
  Case "O". intros. inversion H. reflexivity. inversion H0. inversion H7. subst. Abort.

Inductive RR: nat -> list nat -> Prop :=
| Rc1: RR 0 []
| Rc2: forall n l, RR n l -> RR (S n) (n::l)
| Rc3: forall n l, RR (S n) l -> RR n l.

  Theorem RR1210: RR 2 [1;2;1;0].
  Proof.  apply Rc2. apply Rc3. apply Rc3. apply Rc2. apply Rc2. apply Rc2. apply Rc1. Qed.

(********** Programming with Propositions **********)

Definition plus_fact : Prop := 2 + 2 = 4.
Check plus_fact.
Theorem plus_fact_is_true : plus_fact.
Proof. reflexivity. Qed.

Definition true_for_zero (P:nat->Prop) : Prop :=
  P 0.
Definition true_for_all_numbers (P:nat -> Prop) : Prop :=
  forall n, P n.
Definition preserved_by_S (P:nat -> Prop): Prop :=
  forall (n:nat), P n -> P (S n).

Definition natural_number_induction: Prop :=
  forall (P:nat->Prop),
  true_for_zero P ->
    preserved_by_S P ->
      true_for_all_numbers P.

Definition combine_odd_even (Podd Peven : nat -> Prop) :
  nat -> Prop :=
fun n => if oddb n then Podd n else Peven n.

Theorem combbine_odd_even_intro :
  forall (Podd Peven : nat -> Prop) (n:nat),
    (oddb n = true -> Podd n) ->
      (oddb n = false -> Peven n) ->
        combine_odd_even Podd Peven n.
Proof. intros. unfold combine_odd_even. destruct (oddb n) eqn:Hodd. apply H. reflexivity.  apply H0. reflexivity. Qed.

Theorem combine_odd_even_elim_odd :
  forall (Podd Peven : nat -> Prop) (n : nat),
    combine_odd_even Podd Peven n ->
      oddb n = true ->
        Podd n.
Proof. intros. unfold combine_odd_even in H. rewrite H0 in H. assumption. Qed.


(** * Logic: Logic in Coq *)

Require Export MoreProp.

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

(* ########################################################### *)
(** * Conjunction *)

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

(** Note that, like the definition of [ev] in a previous
    chapter, this definition is parameterized; however, in this case,
    the parameters are themselves propositions, rather than numbers. *)

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

(** 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 :
  (beautiful 0) /\ (beautiful 3).
Proof.
  apply conj.
  Case "left". apply b_0.
  Case "right". apply b_3.  Qed.

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

Theorem and_example' :
  (ev 0) /\ (ev 4).
Proof.
  split.
    Case "left". apply ev_0.
    Case "right". apply ev_SS. apply ev_SS. apply ev_0.  Qed.

(** 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.
  (* FILL IN HERE *) Admitted.
(** [] *)

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]].
(* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars (even__ev) *)
(** Now we can prove the other direction of the equivalence of [even]
   and [ev], which we left hanging in chapter [Prop].  Notice that the
   left-hand conjunct here is the statement we are actually interested
   in; the right-hand conjunct is needed in order to make the
   induction hypothesis strong enough that we can carry out the
   reasoning in the inductive step.  (To see why this is needed, try
   proving the left conjunct by itself and observe where things get
   stuck.) *)

Theorem even__ev : forall n : nat,
  (even n -> ev n) /\ (even (S n) -> ev (S n)).
Proof.
  (* Hint: Use induction on [n]. *)
  (* FILL IN HERE *) Admitted.
(** [] *)

(* ###################################################### *)
(** ** 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.
  (* FILL IN HERE *) Admitted.

Theorem iff_trans : forall P Q R : Prop,
  (P <-> Q) -> (Q <-> R) -> (P <-> R).
Proof.
  (* FILL IN HERE *) Admitted.

(** 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 *)

(** 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.
  inversion 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.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** 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.
  (* FILL IN HERE *) Admitted.
(** [] *)

(* ################################################### *)
(** ** 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.
  (* FILL IN HERE *) Admitted.

Theorem orb_prop : forall b c,
  orb b c = true -> b = true \/ c = true.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem orb_false_elim : forall b c,
  orb b c = false -> b = false /\ c = false.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(* ################################################### *)
(** * 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.
  inversion 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.) *)

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

(** 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.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 1 star (not_both_true_and_false) *)
Theorem not_both_true_and_false : forall P : Prop,
  ~ (P /\ ~P).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

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

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

Theorem five_not_even :
  ~ ev 5.
Proof.
  (* WORKED IN CLASS *)
  unfold not. intros Hev5. inversion Hev5 as [|n Hev3 Heqn].
  inversion Hev3 as [|n' Hev1 Heqn']. inversion Hev1.  Qed.

(** **** Exercise: 1 star (ev_not_ev_S) *)
(** Theorem [five_not_even] confirms the unsurprising fact that five
    is not an even number.  Prove this more interesting fact: *)

Theorem ev_not_ev_S : forall n,
  ev n -> ~ ev (S n).
Proof.
  unfold not. intros n H. induction H. (* not n! *)
  (* FILL IN HERE *) Admitted.
(** [] *)

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

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

(* ########################################################## *)
(** ** 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.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars, optional (beq_nat_false) *)
Theorem beq_nat_false : forall n m,
  beq_nat n m = false -> n <> m.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars, optional (ble_nat_false) *)
Theorem ble_nat_false : forall n m,
  ble_nat n m = false -> ~(n <= m).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(* ############################################################ *)
(** * Existential Quantification *)

(** Another critical logical connective is _existential
    quantification_.  We can express it with the following
    definition: *)

Inductive ex (X:Type) (P : X->Prop) : Prop :=
  ex_intro : forall (witness:X), P witness -> ex X P.

(** That is, [ex] is a family of propositions indexed by a type [X]
    and a property [P] over [X].  In order to give evidence for the
    assertion "there exists an [x] for which the property [P] holds"
    we must actually name a _witness_ -- a specific value [x] -- and
    then give evidence for [P x], i.e., evidence that [x] has the
    property [P].

*)

(** Coq's [Notation] facility can be used to introduce more
    familiar notation for writing existentially quantified
    propositions, exactly parallel to the built-in syntax for
    universally quantified propositions.  Instead of writing [ex nat
    ev] to express the proposition that there exists some number that
    is even, for example, we can write [exists x:nat, ev x].  (It is
    not necessary to understand exactly how the [Notation] definition
    works.) *)

Notation "'exists' x , p" := (ex _ (fun x => p))
  (at level 200, x ident, right associativity) : type_scope.
Notation "'exists' x : X , p" := (ex _ (fun x:X => p))
  (at level 200, x ident, right associativity) : type_scope.

(** We can use the usual set of tactics for
    manipulating existentials.  For example, to prove an
    existential, we can [apply] the constructor [ex_intro].  Since the
    premise of [ex_intro] involves a variable ([witness]) that does
    not appear in its conclusion, we need to explicitly give its value
    when we use [apply]. *)

Example exists_example_1 : exists n, n + (n * n) = 6.
Proof.
  apply ex_intro with (witness:=2).
  reflexivity.  Qed.

(** Note that we have to explicitly give the witness. *)

(** Or, instead of writing [apply ex_intro with (witness:=e)] all the
    time, we can use the convenient shorthand [exists e], which means
    the same thing. *)

Example exists_example_1' : exists n, n + (n * n) = 6.
Proof.
  exists 2.
  reflexivity.  Qed.

(** Conversely, if we have an existential hypothesis in the
    context, we can eliminate it with [inversion].  Note the use
    of the [as...] pattern to name the variable that Coq
    introduces to name the witness value and get evidence that
    the hypothesis holds for the witness.  (If we don't
    explicitly choose one, Coq will just call it [witness], which
    makes proofs confusing.) *)

Theorem exists_example_2 : forall n,
  (exists m, n = 4 + m) ->
  (exists o, n = 2 + o).
Proof.
  intros n H.
  inversion H as [m Hm].
  exists (2 + m).
  apply Hm.  Qed.

(** **** Exercise: 1 star, optional (english_exists) *)
(** In English, what does the proposition
      ex nat (fun n => beautiful (S n))
]]
    mean? *)

(* FILL IN HERE *)

(** **** Exercise: 1 star (dist_not_exists) *)
(** Prove that "[P] holds for all [x]" implies "there is no [x] for
    which [P] does not hold." *)

Theorem dist_not_exists : forall (X:Type) (P : X -> Prop),
  (forall x, P x) -> ~ (exists x, ~ P x).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 3 stars, optional (not_exists_dist) *)
(** (The other direction of this theorem requires the classical "law
    of the excluded middle".) *)

Theorem not_exists_dist :
  excluded_middle ->
  forall (X:Type) (P : X -> Prop),
    ~ (exists x, ~ P x) -> (forall x, P x).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars (dist_exists_or) *)
(** Prove that existential quantification distributes over
    disjunction. *)

Theorem dist_exists_or : forall (X:Type) (P Q : X -> Prop),
  (exists x, P x \/ Q x) <-> (exists x, P x) \/ (exists x, Q x).
Proof.
   (* FILL IN HERE *) Admitted.
(** [] *)

(* Print dist_exists_or. *)

(* ###################################################### *)
(** * Equality *)

(** Even Coq's equality relation is not built in.  It has (roughly)
    the following inductive definition. *)

(* (We enclose the definition in a module to avoid confusion with the
    standard library equality, which we have used extensively
    already.) *)

Module MyEquality.

Inductive eq {X:Type} : X -> X -> Prop :=
  refl_equal : forall x, eq x x.
(** Standard infix notation: *)

Notation "x = y" := (eq x y)
                    (at level 70, no associativity)
                    : type_scope.

(** The definition of [=] is a bit subtle.  The way to think about it
    is that, given a set [X], it defines a _family_ of propositions
    "[x] is equal to [y]," indexed by pairs of values ([x] and [y])
    from [X].  There is just one way of constructing evidence for
    members of this family: applying the constructor [refl_equal] to a
    type [X] and a value [x : X] yields evidence that [x] is equal to
    [x]. *)

(** **** Exercise: 2 stars (leibniz_equality) *)
(** The inductive definitions of equality corresponds to _Leibniz equality_:
   what we mean when we say "[x] and [y] are equal" is that every
   property on [P] that is true of [x] is also true of [y].  *)

Lemma leibniz_equality : forall (X : Type) (x y: X),
 x = y -> forall P : X -> Prop, P x -> P y.
Proof.
(* FILL IN HERE *) Admitted.
(** [] *)

(** We can use
    [refl_equal] to construct evidence that, for example, [2 = 2].
    Can we also use it to construct evidence that [1 + 1 = 2]?  Yes:
    indeed, it is the very same piece of evidence!  The reason is that
    Coq treats as "the same" any two terms that are _convertible_
    according to a simple set of computation rules.  These rules,
    which are similar to those used by [Eval compute], include
    evaluation of function application, inlining of definitions, and
    simplification of [match]es.
*)

Lemma four: 2 + 2 = 1 + 3.
Proof.
  apply refl_equal.
Qed.

(** The [reflexivity] tactic that we have used to prove equalities up
to now is essentially just short-hand for [apply refl_equal]. *)

End MyEquality.

(* ###################################################### *)
(** * Evidence-carrying booleans. *)

(** So far we've seen two different forms of equality predicates:
[eq], which produces a [Prop], and
the type-specific forms, like [beq_nat], that produce [boolean]
values.  The former are more convenient to reason about, but
we've relied on the latter to let us use equality tests
in _computations_.  While it is straightforward to write lemmas
(e.g. [beq_nat_true] and [beq_nat_false]) that connect the two forms,
using these lemmas quickly gets tedious.

It turns out that we can get the benefits of both forms at once
by using a construct called [sumbool]. *)

Inductive sumbool (A B : Prop) : Set :=
 | left : A -> sumbool A B
 | right : B -> sumbool A B.

Notation "{ A } + { B }" :=  (sumbool A B) : type_scope.

(** Think of [sumbool] as being like the [boolean] type, but instead
of its values being just [true] and [false], they carry _evidence_
of truth or falsity. This means that when we [destruct] them, we
are left with the relevant evidence as a hypothesis -- just as with [or].
(In fact, the definition of [sumbool] is almost the same as for [or].
The only difference is that values of [sumbool] are declared to be in
[Set] rather than in [Prop]; this is a technical distinction
that allows us to compute with them.) *)

(** Here's how we can define a [sumbool] for equality on [nat]s *)

Theorem eq_nat_dec : forall n m : nat, {n = m} + {n <> m}.
Proof.
  intros n.
  induction n as [|n'].
  Case "n = 0".
    intros m.
    destruct m as [|m'].
    SCase "m = 0".
      left. reflexivity.
    SCase "m = S m'".
      right. intros contra. inversion contra.
  Case "n = S n'".
    intros m.
    destruct m as [|m'].
    SCase "m = 0".
      right. intros contra. inversion contra.
    SCase "m = S m'".
      destruct IHn' with (m := m') as [eq | neq].
      left. apply f_equal.  apply eq.
      right. intros Heq. inversion Heq as [Heq']. apply neq. apply Heq'.
Defined.

(** Read as a theorem, this says that equality on [nat]s is decidable:
that is, given two [nat] values, we can always produce either
evidence that they are equal or evidence that they are not.
Read computationally, [eq_nat_dec] takes two [nat] values and returns
a [sumbool] constructed with [left] if they are equal and [right]
if they are not; this result can be tested with a [match] or, better,
with an [if-then-else], just like a regular [boolean].
(Notice that we ended this proof with [Defined] rather than [Qed].
The only difference this makes is that the proof becomes _transparent_,
meaning that its definition is available when Coq tries to do reductions,
which is important for the computational interpretation.)

Here's a simple example illustrating the advantages of the [sumbool] form. *)

Definition override' {X: Type} (f: nat->X) (k:nat) (x:X) : nat->X:=
  fun (k':nat) => if eq_nat_dec k k' then x else f k'.

Theorem override_same' : forall (X:Type) x1 k1 k2 (f : nat->X),
  f k1 = x1 ->
  (override' f k1 x1) k2 = f k2.
Proof.
  intros X x1 k1 k2 f. intros Hx1.
  unfold override'.
  destruct (eq_nat_dec k1 k2).   (* observe what appears as a hypothesis *)
  Case "k1 = k2".
    rewrite <- e.
    symmetry. apply Hx1.
  Case "k1 <> k2".
    reflexivity.  Qed.

(** Compare this to the more laborious proof (in MoreCoq.v) for the
   version of [override] defined using [beq_nat], where we had to
   use the auxiliary lemma [beq_nat_true] to convert a fact about booleans
   to a Prop. *)

(** **** Exercise: 1 star (override_shadow') *)
Theorem override_shadow' : forall (X:Type) x1 x2 k1 k2 (f : nat->X),
  (override' (override' f k1 x2) k1 x1) k2 = (override' f k1 x1) k2.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(* ####################################################### *)
(** ** Inversion, Again (Advanced) *)

(** We've seen [inversion] used with both equality hypotheses and
    hypotheses about inductively defined propositions.  Now that we've
    seen that these are actually the same thing, we're in a position
    to take a closer look at how [inversion] behaves...

    In general, the [inversion] tactic

    - takes a hypothesis [H] whose type [P] is inductively defined,
      and

    - for each constructor [C] in [P]'s definition,

      - generates a new subgoal in which we assume [H] was
        built with [C],

      - adds the arguments (premises) of [C] to the context of
        the subgoal as extra hypotheses,

      - matches the conclusion (result type) of [C] against the
        current goal and calculates a set of equalities that must
        hold in order for [C] to be applicable,

      - adds these equalities to the context (and, for convenience,
        rewrites them in the goal), and

      - if the equalities are not satisfiable (e.g., they involve
        things like [S n = O]), immediately solves the subgoal. *)

(** _Example_: If we invert a hypothesis built with [or], there are two
   constructors, so two subgoals get generated.  The
   conclusion (result type) of the constructor ([P \/ Q]) doesn't
   place any restrictions on the form of [P] or [Q], so we don't get
   any extra equalities in the context of the subgoal.

   _Example_: If we invert a hypothesis built with [and], there is
   only one constructor, so only one subgoal gets generated.  Again,
   the conclusion (result type) of the constructor ([P /\ Q]) doesn't
   place any restrictions on the form of [P] or [Q], so we don't get
   any extra equalities in the context of the subgoal.  The
   constructor does have two arguments, though, and these can be seen
   in the context in the subgoal.

   _Example_: If we invert a hypothesis built with [eq], there is
   again only one constructor, so only one subgoal gets generated.
   Now, though, the form of the [refl_equal] constructor does give us
   some extra information: it tells us that the two arguments to [eq]
   must be the same!  The [inversion] tactic adds this fact to the
   context.  *)

(** **** Exercise: 1 star, optional (dist_and_or_eq_implies_and) *)
Lemma dist_and_or_eq_implies_and : forall P Q R,
       P /\ (Q \/ R) /\ Q = R -> P/\Q.
Proof.
(* FILL IN HERE *) Admitted.
(** [] *)

(* ####################################################### *)
(** * Additional Exercises *)

(** **** Exercise: 3 stars (all_forallb) *)
(** Inductively define a property [all] of lists, parameterized by a
    type [X] and a property [P : X -> Prop], such that [all X P l]
    asserts that [P] is true for every element of the list [l]. *)

Inductive all (X : Type) (P : X -> Prop) : list X -> Prop :=
  (* FILL IN HERE *)
.

(** Recall the function [forallb], from the exercise
    [forall_exists_challenge] in chapter [Poly]: *)

Fixpoint forallb {X : Type} (test : X -> bool) (l : list X) : bool :=
  match l with
    | [] => true
    | x :: l' => andb (test x) (forallb test l')
  end.

(** Using the property [all], write down a specification for [forallb],
    and prove that it satisfies the specification. Try to make your
    specification as precise as possible.

    Are there any important properties of the function [forallb] which
    are not captured by your specification? *)

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

(** **** Exercise: 4 stars, advanced (filter_challenge) *)
(** One of the main purposes of Coq is to prove that programs match
    their specifications.  To this end, let's prove that our
    definition of [filter] matches a specification.  Here is the
    specification, written out informally in English.

    Suppose we have a set [X], a function [test: X->bool], and a list
    [l] of type [list X].  Suppose further that [l] is an "in-order
    merge" of two lists, [l1] and [l2], such that every item in [l1]
    satisfies [test] and no item in [l2] satisfies test.  Then [filter
    test l = l1].

    A list [l] is an "in-order merge" of [l1] and [l2] if it contains
    all the same elements as [l1] and [l2], in the same order as [l1]
    and [l2], but possibly interleaved.  For example,
    [1,4,6,2,3]
    is an in-order merge of
    [1,6,2]
    and
    [4,3].
    Your job is to translate this specification into a Coq theorem and
    prove it.  (Hint: You'll need to begin by defining what it means
    for one list to be a merge of two others.  Do this with an
    inductive relation, not a [Fixpoint].)  *)

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

(** **** Exercise: 5 stars, advanced, optional (filter_challenge_2) *)
(** A different way to formally characterize the behavior of [filter]
    goes like this: Among all subsequences of [l] with the property
    that [test] evaluates to [true] on all their members, [filter test
    l] is the longest.  Express this claim formally and prove it. *)

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

(** **** Exercise: 4 stars, advanced (no_repeats) *)
(** The following inductively defined proposition... *)

Inductive appears_in {X:Type} (a:X) : list X -> Prop :=
  | ai_here : forall l, appears_in a (a::l)
  | ai_later : forall b l, appears_in a l -> appears_in a (b::l).

(** ...gives us a precise way of saying that a value [a] appears at
    least once as a member of a list [l].

    Here's a pair of warm-ups about [appears_in].
*)

Lemma appears_in_app : forall (X:Type) (xs ys : list X) (x:X),
     appears_in x (xs ++ ys) -> appears_in x xs \/ appears_in x ys.
Proof.
  (* FILL IN HERE *) Admitted.

Lemma app_appears_in : forall (X:Type) (xs ys : list X) (x:X),
     appears_in x xs \/ appears_in x ys -> appears_in x (xs ++ ys).
Proof.
  (* FILL IN HERE *) Admitted.

(** Now use [appears_in] to define a proposition [disjoint X l1 l2],
    which should be provable exactly when [l1] and [l2] are
    lists (with elements of type X) that have no elements in common. *)

(* FILL IN HERE *)

(** Next, use [appears_in] to define an inductive proposition
    [no_repeats X l], which should be provable exactly when [l] is a
    list (with elements of type [X]) where every member is different
    from every other.  For example, [no_repeats nat [1,2,3,4]] and
    [no_repeats bool []] should be provable, while [no_repeats nat
    [1,2,1]] and [no_repeats bool [true,true]] should not be.  *)

(* FILL IN HERE *)

(** Finally, state and prove one or more interesting theorems relating
    [disjoint], [no_repeats] and [++] (list append).  *)

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

(** **** Exercise: 3 stars (nostutter) *)
(** Formulating inductive definitions of predicates is an important
    skill you'll need in this course.  Try to solve this exercise
    without any help at all (except from your study group partner, if
    you have one).

    We say that a list of numbers "stutters" if it repeats the same
    number consecutively.  The predicate "[nostutter mylist]" means
    that [mylist] does not stutter.  Formulate an inductive definition
    for [nostutter].  (This is different from the [no_repeats]
    predicate in the exercise above; the sequence [1,4,1] repeats but
    does not stutter.) *)

Inductive nostutter:  list nat -> Prop :=
 (* FILL IN HERE *)
.

(** Make sure each of these tests succeeds, but you are free
    to change the proof if the given one doesn't work for you.
    Your definition might be different from mine and still correct,
    in which case the examples might need a different proof.

    The suggested proofs for the examples (in comments) use a number
    of tactics we haven't talked about, to try to make them robust
    with respect to different possible ways of defining [nostutter].
    You should be able to just uncomment and use them as-is, but if
    you prefer you can also prove each example with more basic
    tactics.  *)

Example test_nostutter_1:      nostutter [3;1;4;1;5;6].
(* FILL IN HERE *) Admitted.
(*
  Proof. repeat constructor; apply beq_nat_false; auto. Qed.
*)

Example test_nostutter_2:  nostutter [].
(* FILL IN HERE *) Admitted.
(*
  Proof. repeat constructor; apply beq_nat_false; auto. Qed.
*)

Example test_nostutter_3:  nostutter [5].
(* FILL IN HERE *) Admitted.
(*
  Proof. repeat constructor; apply beq_nat_false; auto. Qed.
*)

Example test_nostutter_4:      not (nostutter [3;1;1;4]).
(* FILL IN HERE *) Admitted.
(*
  Proof. intro.
  repeat match goal with
    h: nostutter _ |- _ => inversion h; clear h; subst
  end.
  contradiction H1; auto. Qed.
*)
(** [] *)

(** **** Exercise: 4 stars, advanced (pigeonhole principle) *)
(** The "pigeonhole principle" states a basic fact about counting:
   if you distribute more than [n] items into [n] pigeonholes, some
   pigeonhole must contain at least two items.  As is often the case,
   this apparently trivial fact about numbers requires non-trivial
   machinery to prove, but we now have enough... *)

(** First a pair of useful lemmas (we already proved these for lists
    of naturals, but not for arbitrary lists). *)

Lemma app_length : forall (X:Type) (l1 l2 : list X),
  length (l1 ++ l2) = length l1 + length l2.
Proof.
  (* FILL IN HERE *) Admitted.

Lemma appears_in_app_split : forall (X:Type) (x:X) (l:list X),
  appears_in x l ->
  exists l1, exists l2, l = l1 ++ (x::l2).
Proof.
  (* FILL IN HERE *) Admitted.

(** Now define a predicate [repeats] (analogous to [no_repeats] in the
   exercise above), such that [repeats X l] asserts that [l] contains
   at least one repeated element (of type [X]).  *)

Inductive repeats {X:Type} : list X -> Prop :=
  (* FILL IN HERE *)
.

(** Now here's a way to formalize the pigeonhole principle. List [l2]
   represents a list of pigeonhole labels, and list [l1] represents an
   assignment of items to labels: if there are more items than labels,
   at least two items must have the same label.  You will almost
   certainly need to use the [excluded_middle] hypothesis. *)

Theorem pigeonhole_principle: forall (X:Type) (l1 l2:list X),
  excluded_middle ->
  (forall x, appears_in x l1 -> appears_in x l2) ->
  length l2 < length l1 ->
  repeats l1.
Proof.  intros X l1. induction l1.
  (* FILL IN HERE *) Admitted.
(** [] *)

(* $Date: 2013-07-17 16:19:11 -0400 (Wed, 17 Jul 2013) $ *)


(* This file is extracted from the TLC library.
   http://github.com/charguer/tlc
   DO NOT EDIT. *)

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

Set Implicit Arguments.
From SLF 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 *)

Declare Scope comp_scope.

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. *)

Declare Scope comp_scope_reflect.

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.

(* ********************************************************************** *)
(* ################################################################# *)
(* * Min and max *)

Definition min `{Le A} (n m:A) : A :=
  If n <= m then n else m.

Lemma min_l : forall `{Le A} (n m:A),
  antisym le ->
  n <= m ->
  min n m = n.
Proof using. introv T M. unfold min. case_if*. Qed.

Lemma min_r : forall `{Le A} (n m:A),
  antisym le ->
  m <= n ->
  min n m = m.
Proof using. introv T M. unfold min. case_if*. Qed.

Definition max `{Le A} (n m:A) : A :=
  If n <= m then m else n.

Lemma max_l : forall `{Le A} (n m:A),
  antisym le ->
  n >= m ->
  max n m = n.
Proof using. introv T M. unfold max. case_if*. Qed.

Lemma max_r : forall `{Le A} (n m:A),
  antisym le ->
  n <= m ->
  max n m = m.
Proof using. introv T M. unfold max. case_if*. Qed.

(* 2021-08-11 15:24 *)


(* ================================================================== *)
Section EX_1.

Variable A:Prop.
Variable B:Prop.
Variable C:Prop.
Variable D:Prop.

Lemma ex_1_1 : (A -> C) /\ (B -> C) -> (A /\ B) -> C.
Proof.
  intros.
  apply H.
  apply H0.
Qed.

Lemma ex_1_2 : (~A \/ ~B) -> ~(A /\ B).
Proof.
  intros.
  intro.
  destruct H.
  destruct H0.
  apply H.
  apply H0.
  destruct H0.
  apply H.
  apply H1.
Qed.

Lemma ex_1_3 : (A -> (B \/ C)) /\ (B -> D) /\ (C -> D) -> (A -> D).
Proof.
  intros.
  destruct H.
  destruct H1.
  destruct H.
  assumption.
  apply H1.
  assumption.
  apply H2.
  assumption.
Qed.

Lemma ex_1_4 : (A /\ B) -> ~(~A \/ ~B).
Proof.
  intros.
  intro.
  destruct H.
  destruct H0.
  contradiction.
  contradiction.
Qed.

End EX_1.

Section EX_2.

Variable X : Set.
Variables P Q R : X -> Prop.

Lemma ex_2_1 : (forall x : X, P x -> Q x) -> (forall y : X, ~(Q y)) -> (forall x : X, ~(P x)).
Proof.
  intros.
  intro.
  destruct (H0 x).
  apply H.
  assumption.
Qed.

Lemma ex_2_2 : (forall x:X, P x \/ Q x) -> (exists y:X, ~Q y) -> (forall x:X, R x -> ~P x) -> (exists x:X, ~R x).
Proof.
  intros.
  destruct H0.
  exists x.
  intro.
  destruct (H1 x).
  assumption.
  destruct (H x).
  assumption.
  contradiction.
Qed.

End EX_2.

Section EX_3.

Variable A B : Prop.
Variable X : Set.
Variable P : X -> Prop.

Hypothesis Excluded_middle : forall P : Prop, P \/ ~P.

Lemma ex_3_1 : (~A -> B) -> (~B -> A).
Proof.
  intros.
  destruct Excluded_middle with A.
  assumption.
  destruct H0.
  apply H.
  assumption.
Qed.

Lemma ex_3_2 : ~(exists x:X, ~P x) -> (forall x:X, P x).
Proof.
  intros.
  destruct Excluded_middle with (P x).
  exact H0.
  destruct H.
  exists x.
  assumption.
Qed.

Lemma ex_3_3 : ~(forall x:X, ~P x) -> (exists x:X, P x).
Proof.
  intros.
  destruct Excluded_middle with (exists x, P x).
  exact H0.
  destruct H.
  intro x0.
  destruct Excluded_middle with (~P x0).
  assumption.
  unfold not.
  intro.
  destruct H0.
  exists x0.
  assumption.
Qed.

End EX_3.


Class Eq (a : Type) : Type :=
    { equal : a -> a -> Prop
    ; refl  : forall (x:a), equal x x
    ; sym   : forall (x y:a), equal x y -> equal y x
    ; trans : forall (x y z:a), equal x y -> equal y z -> equal x z
    }.

Definition notEqual (a:Type) (_:Eq a) (x y:a) : Prop := ~ equal x y.

Definition prodEqual (a b:Type) (_:Eq a) (_:Eq b) (p q:a * b) : Prop :=
    match p with
    | (x,y) =>
        match q with
        | (x',y') => equal x x' /\ equal y y'
        end
    end.

Arguments prodEqual {a} {b}.

Lemma prodRefl : forall (a b:Type) (e:Eq a) (e':Eq b) (p:a * b),
    prodEqual _ _ p p.
Proof.
    intros a b e e' p. destruct p as (x,y). unfold prodEqual. split; apply refl.
Qed.

Arguments prodRefl {a} {b}.

Lemma prodSym : forall (a b:Type) (e:Eq a) (e':Eq b) (p q:a * b),
    prodEqual _ _ p q -> prodEqual _ _ q p.
Proof.
    intros a b e e' p q. destruct p as (x,x'), q as (y,y'). simpl.
    intros [H H']. split; apply sym; assumption.
Qed.

Arguments prodSym {a} {b}.

Lemma prodTrans : forall (a b:Type) (e:Eq a) (e':Eq b) (p q r:a * b),
    prodEqual _ _ p q -> prodEqual _ _ q r -> prodEqual _ _ p r.
Proof.
    intros a  b e e' p q r. destruct p as (x,x'), q as (y,y'), r as (z,z'). simpl.
    intros [H H'] [I I']. split.
    - apply trans with y;  assumption.
    - apply trans with y'; assumption.
Qed.

Arguments prodTrans {a} {b}.

Instance prodEq (a b:Type) (_:Eq a) (_:Eq b) : Eq (a * b) :=
    { equal := prodEqual _ _
    ; refl  := prodRefl _ _
    ; sym   := prodSym _ _
    ; trans := prodTrans _ _
    }.

Instance defaultEq (a:Type) : Eq a :=
    { equal := fun (x y:a)                      => x = y
    ; refl  := fun (x:a)                        => eq_refl x
    ; sym   := fun (x y:a) (p:x=y)              => eq_sym p
    ; trans := fun (x y z:a) (p:x=y) (q:y=z)    => eq_trans p q
    }.

Class Ord (a :Type) (e:Eq a) : Type :=
    { le     : a -> a -> Prop
    ; cong   : forall (x x' y y':a), equal x x' -> equal y y' -> le x y -> le x' y'
    ; refl'  : forall (x:a), le x x
    ; trans' : forall (x y z:a), le x y -> le y z -> le x z
    }.