(*Dokaz algoritma insertion sort.*)

(*KNJIŽNICE*)
Require Import List.
Require Import Bool.
Require Import ZArith.
Require Import Recdef.
(*Notacija za sezname.*)
Open Scope list_scope.
Open Scope Z_scope.

(*-----   INSERTION SORT   -----*)

(*Funkcija, ki vstavi trenutni element na pravo mesto v seznam.*)
Fixpoint vstavi (x : Z) (l : list Z) : list Z :=
  match l with
    | nil => x :: nil
    | y :: l' => if Z.leb x y
                 then x :: y :: l'
                 else y :: vstavi x l'
  end.

(*Funcija za insertion sort.*)
Fixpoint insertion_sort (l : list Z) : list Z:=
  match l with
  | nil => nil
  | x::l' => vstavi x (insertion_sort l')
end.

(*-----   UREJEN SEZNAM   -----*)

(*Funkcija, ki preveri ali je seznam urejen.*)
Fixpoint urejen (l : list Z) :=
  match l with
    | nil => True
    | _ :: nil => True
    | x :: ((y :: _) as l') => x <= y /\ urejen l'
  end.

Lemma urejen_tail(x : Z)(l:list Z): urejen(x::l)-> urejen l.
Proof.
 induction l; firstorder.
Qed.

(*-----   PERMUTIRAN SEZNAM   -----*)

(*Prešteje kolikokrat se pojavi iskani element.*)
Fixpoint pojavi (x : Z) (l : list Z) : nat :=
  match l with
    | nil => O
    | y :: l' => if x =? y then S (pojavi x l') else pojavi x l'
  end.

(*Definicija, ki pove kaj pomeni, da je l' permutacija l.*)
Definition permutiran_seznam (l l' : list Z) :=
  forall x : Z, pojavi x l = pojavi x l'.

(*Notacija za permutacijo.*)
Notation "l ~~ l'" := (permutiran_seznam l l')(at level 70).

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

(*Pomožna lema za dokaz urejenosti.*)
Lemma urejen_po_vstavljanju (x : Z) (l : list Z): urejen l -> urejen (vstavi x l).
Proof.
  intro.
  induction l ; simpl; auto.
  case_eq (x <=? a)%Z.
    + intro G.
      simpl.
      split.
      *apply Zle_is_le_bool in G.
       auto.
      *apply H.
    + intro G.
      simpl.
      destruct l.
      * simpl.
        split.
        apply Z.lt_le_incl.
        apply Z.leb_gt in G.
        auto.
        auto.
      * simpl.
        apply Z.leb_gt in G.
        case_eq (x <=? z).
        - intro A.
          apply Z.leb_le in A.
          split; firstorder.
        - intro B.
          apply Z.leb_gt in B.
          split; firstorder.
          replace (z :: vstavi x l) with (vstavi x(z :: l)).
          apply H1.
          simpl.
          apply Z.leb_gt in B.
          rewrite B.
          reflexivity.
Qed.

(*Pomožna lema za dokaz permutacije.*)
Lemma vstavi_enak (x : Z) (l : list Z): pojavi x (vstavi x l) = S (pojavi x l).
Proof.
 induction l.
 - simpl; rewrite Z.eqb_refl; auto.
 - simpl; case_eq (x <=? a).
   + intro; simpl; rewrite Z.eqb_refl; auto.
   + intro; simpl; case (x =? a); auto.
Qed.

(*Pomožna lema za dokaz permutacije.*)
Lemma vstavi_ni_enak (x y : Z) (l : list Z): (x =? y = false) -> pojavi x l = pojavi x (vstavi y l).
Proof.
  induction l.
  - intro; simpl; rewrite H; auto.
  - intro; simpl.
    case_eq (x =? a).
    + intro G.
      case_eq (y <=? a).
      * intro G1; simpl; rewrite H, G; auto.
      * intro G2; simpl; rewrite IHl, G; auto.
    + intro G.
      case_eq (y <=? a).
      * intro G1; simpl; rewrite H, G; auto.
      * intro G2; simpl; rewrite IHl, G; auto.
Qed.

(*Dokazati moramo, da je seznam v insertion_sort permutiran vhodni seznam in da je urejen.*)
Theorem permutacija (l : list Z): l ~~ insertion_sort l.
Proof.
 induction l.
 - intro; auto.
 - intro; simpl.
   case_eq (x =? a).
   + intro; simpl.
     rewrite IHl.
     rewrite Z.eqb_eq in H.
     rewrite H.
     rewrite (vstavi_enak a (insertion_sort l)).
     auto.
   + intro.
     rewrite IHl.
     rewrite (vstavi_ni_enak x a (insertion_sort l)).
     * auto.
     * apply H.
Qed.

Theorem urejenost (l : list Z): urejen(insertion_sort l).
Proof.
 - induction l.
   + simpl; auto.
   + simpl.
     apply urejen_po_vstavljanju.
     simpl.
     auto.
Qed.


Load LFindLoad.
From lfind Require Import LFind.
Unset Printing Notations.
Set Printing Implicit.

From QuickChick Require Import QuickChick.
Inductive natural : Type := Succ : natural -> natural |  Zero : natural.
Derive Show for natural. Derive Arbitrary for natural.  Instance Dec_Eq_natural : Dec_Eq natural. Proof. dec_eq. Qed.
Inductive lst : Type :=   Nil : lst | Cons : natural -> lst -> lst .

Inductive tree : Type := Node : natural -> tree -> tree -> tree |  Leaf : tree.

Inductive Pair : Type := mkpair : natural -> natural -> Pair
with Zlst : Type := zcons : Pair -> Zlst -> Zlst |  znil : Zlst.

Fixpoint plus (plus_arg0 : natural) (plus_arg1 : natural) : natural
           := match plus_arg0, plus_arg1 with
              | Zero, n => n
              | Succ n, m => Succ (plus n m)
              end.

Fixpoint mult (mult_arg0 : natural) (mult_arg1 : natural) : natural
           := match mult_arg0, mult_arg1 with
              | Zero, n => Zero
              | Succ n, m => plus (mult n m) m
              end.

Fixpoint qmult (qmult_arg0 : natural) (qmult_arg1 : natural) (qmult_arg2 : natural) : natural
           := match qmult_arg0, qmult_arg1, qmult_arg2 with
              | Zero, n, m => m
              | Succ n, m, p => qmult n m (plus p m)
              end.

Lemma plus_succ : forall (x y : natural), plus x (Succ y) = Succ (plus x y).
Proof.
   intros.
   induction x.
   - simpl. rewrite IHx. reflexivity.
   - reflexivity.
Qed.

Lemma plus_assoc : forall (x y z : natural), plus (plus x y) z = plus x (plus y z).
Proof.
   intros.
   induction x.
   - simpl. rewrite IHx. reflexivity.
   - reflexivity.
Qed.

Lemma plus_zero : forall (x : natural), plus x Zero = x.
Proof.
   intros.
   induction x.
   - simpl. rewrite IHx. reflexivity.
   - reflexivity.

Qed.

Lemma plus_commut : forall (x y : natural), plus x y = plus y x.
Proof.
   intros.
   induction x.
   - simpl. lfind.  rewrite IHx.  reflexivity.
Admitted.

Theorem theorem0 : forall (x : natural) (y : natural) (z : natural), eq (plus (mult x y) z) (qmult x y z).
Proof.
   induction x.

   - intros. simpl. rewrite <- IHx. rewrite plus_assoc. rewrite (plus_commut y z). reflexivity.
   - reflexivity.
Qed.


Set Warnings "-notation-overridden,-parsing".
Require Import Psatz.
Require Import Init.
Require Import QArith.
Require Import QArith.Qround.
Require Import Omega.

(***********   This is library ****************)

Definition INQ (n: nat) : Q := inject_Z (Z.of_nat n).

Coercion INQ: nat >-> Q.

Theorem INQ_plus : forall n m : nat , INQ n + INQ m == INQ (n + m).
Proof.
  intros.
  unfold INQ.
  rewrite <- inject_Z_plus.
  apply inject_Z_injective.
  rewrite <- Nat2Z.inj_add. auto.
Qed.

Theorem INQ_minus : forall n m : nat , (n >= m)%nat -> INQ (n - m) == INQ n - INQ m.
Proof.
  intros.
  assert (n - m >= 0)%nat. { omega. }
  remember (n - m)%nat as p.
  assert (n = p + m)%nat. { omega. }
  unfold Qminus.
  rewrite H1.
  rewrite <- INQ_plus. field.
Qed.

Theorem INQ_mult : forall n m : nat , INQ n * INQ m == INQ (n * m).
Proof.
  intros.
  unfold INQ.
  rewrite <- inject_Z_mult.
  apply inject_Z_injective.
  rewrite <- Nat2Z.inj_mul. auto.
Qed.

Theorem eq_INQ_Qeq : forall n m : nat, (n = m)%nat -> (INQ n == INQ m).
Proof.
  intros.
  unfold INQ.
  rewrite H. reflexivity.
Qed.

Theorem Qeq_INQ_eq : forall n m : nat ,(INQ n == INQ m) -> (n = m)%nat.
Proof.
  intros.
  unfold INQ in H.
  rewrite inject_Z_injective in H.
  apply Nat2Z.inj. auto.
Qed.

Theorem INQ_le : forall n m : nat, (n >= m)%nat <-> (INQ n) >= (INQ m).
Proof.
  intros.
  unfold INQ.
  split ; intros.
  - rewrite <- Zle_Qle.
    apply inj_le. auto.
  - rewrite <- Zle_Qle in H.
    apply Nat2Z.inj_le. auto.
Qed.

Theorem INQ_lt : forall n m : nat, (n > m)%nat <-> (INQ n) > (INQ m).
Proof.
  intros.
  unfold INQ.
  split ; intros.
  - rewrite <- Zlt_Qlt.
    apply inj_lt. auto.
  - rewrite <- Zlt_Qlt in H.
    apply Nat2Z.inj_lt. auto.
Qed.

Lemma INQ_nonneg: forall n, INQ n >= 0.
Proof.
  intros.
  unfold INQ.
  change 0 with (inject_Z 0).
  rewrite <- Zle_Qle.
  omega.
Qed.

Lemma INQ_S: forall n,  (((S n):Q) = n + 1)%Q.
Proof.
  intros.
  unfold INQ.
  change 1 with (inject_Z 1).
  rewrite <- inject_Z_plus.
  f_equal.
  rewrite Nat2Z.inj_succ.
  omega.
Qed.

Lemma INQ_Qeq_0 : (INQ 0 == 0)%Q.
Proof.
  reflexivity.
Qed.

Lemma INQ_Qeq_1 : (INQ 1 == 1)%Q.
Proof.
  reflexivity.
Qed.

Lemma INQ_eq_1 : (INQ 1 = 1)%Q.
Proof.
  reflexivity.
Qed.

Ltac clear_INQ :=
  repeat rewrite INQ_S in *;
  try change (INQ 0) with (0 # 1) in *.

Ltac solve_nonzero :=
  match goal with
  | |- context [INQ ?n] =>
    generalize (INQ_nonneg n);
    let m := fresh n in
    let H := fresh "H" in
    remember (INQ n) as m eqn:H;
    clear H; try clear n;
    intros
  end.

Lemma Max_pown_0 : forall n : nat , (2 ^ n > 0)%nat.
Proof.
  intros. induction n.
  + simpl. omega.
  + rewrite Nat.pow_succ_r'. omega.
Qed.

Lemma Max_powan_0 : forall (a n : nat), (a > 0)%nat -> (a ^ n > 0)%nat.
Proof.
  intros. induction n.
  + simpl. omega.
  + rewrite Nat.pow_succ_r'.
    apply Nat.mul_pos_pos ; auto.
Qed.

Lemma Max_pown_0Q : forall n : nat , (INQ (2 ^ n) > 0)%Q.
Proof.
  intros.
  rewrite <- INQ_Qeq_0.
  apply INQ_lt. apply Max_pown_0.
Qed.

Lemma Max_powSn_1 : forall n : nat , ( n >= 1 -> 2 ^ n > 1)%nat.
Proof.
  intros.
  induction n.
  - inversion H.
  - simpl. rewrite <- plus_n_O.
    apply Nat.lt_le_trans with (m := (1 + 2 ^ n) % nat).
    simpl. apply lt_n_S. apply Max_pown_0.
    apply plus_le_compat_r.
    pose proof Max_pown_0 n.
    apply H0.
Qed.

Lemma Z_le_lt_trans : forall z1 z2 z3 :Z , (z1 <= z2 -> z2 < z3 -> z1 < z3)%Z.
Proof.
  intros.
  apply Zle_compare in H.
  destruct ((z1 ?= z2) % Z) eqn : En.
  - apply Z.compare_eq in En. rewrite En. auto.
  - apply Zcompare_Lt_trans with z2 ; auto.
  - inversion H.
Qed.

Lemma Z_to_nat_le : forall z : Z , (inject_Z z <= Z.to_nat z)%Q.
Proof.
  intros.
  destruct z ; unfold Qle.
  - simpl. omega.
  - remember (Z.pos p) as p0.
    simpl.
    rewrite !Zmult_1_r.
    pose proof Zle_0_pos p.
    pose proof Z2Nat.id (Z.pos p) H.
    rewrite <- Heqp0 in H0. omega.
  - simpl.
    apply Z.lt_le_incl.
    apply Zlt_neg_0.
Qed.

Lemma eps_lemma1 : forall eps : Q , (eps > 0)%Q -> { n : nat | (INQ (n) > 1 / eps)%Q}.
Proof.
  intros.
  exists (S (Z.to_nat (Qceiling (1 / eps)))).
  rewrite INQ_S.
  apply Qlt_le_trans with (y := (inject_Z (Qceiling (1/eps)) + 1)%Q).
  - pose proof  (Qle_ceiling (1/eps)).
    rewrite Qplus_comm.
    rewrite <- Qplus_0_l at 1.
    apply Qplus_lt_le_compat ; auto.
    unfold Qlt. simpl. omega.
  - apply Qplus_le_l.
    remember (Qceiling (1 / eps)) as z.
    apply Z_to_nat_le.
Qed.

Lemma eps_lemma_total : forall eps : Q , { n : nat | (INQ (n) > 1 / eps)%Q}.
Proof.
  intros.
  destruct (Q_dec 0 eps).
  - destruct s.
    + apply eps_lemma1. auto.
    + exists O.
      rewrite INQ_Qeq_0.
      rewrite <- Qopp_opp.
      rewrite <- (Qopp_opp 0).
      apply Qopp_lt_compat.
      apply Qopp_lt_compat in q as goal.
      assert ( -0 == 0). { reflexivity. }
      rewrite H in *.
      apply Qinv_lt_0_compat in goal.
      assert (/ - eps == - (1 / eps)).
      { field. unfold not. intros. rewrite H0 in q. apply (Qlt_irrefl 0). auto. }
      rewrite <- H0. auto.
  - exists 1%nat. rewrite <- q.
    rewrite INQ_Qeq_1.
    unfold Qlt. simpl. omega.
Qed.

Definition eps_arrow_nat(eps : Q) : nat.
  pose proof eps_lemma_total eps.
  inversion H.
  apply x.
Defined.

Lemma eps_arrow_correct : forall eps : Q , (INQ(eps_arrow_nat eps ) >  1 / eps)%Q.
Proof.
  intros.
  unfold eps_arrow_nat.
  destruct (eps_lemma_total eps).
  auto.
Qed.

Lemma eps_arrow_pro : forall eps : Q, (eps > 0)%Q -> (INQ(eps_arrow_nat eps) > 0)%Q.
Proof.
  intros.
  pose proof eps_arrow_correct eps.
  remember (eps_arrow_nat eps) as n0.
  apply Qlt_trans with (y := 1 / eps) ; auto.
  assert (1 / eps == / eps). { field. unfold not. intros. rewrite H1 in H.
         apply (Qlt_irrefl 0). auto. }
  rewrite H1.
  apply Qinv_lt_0_compat ; auto.
Qed.


Require Import ProofCheckingEuclid.euclidean_axioms.
Require Import ProofCheckingEuclid.euclidean_defs.
Require Import ProofCheckingEuclid.lemma_NCdistinct.
Require Import ProofCheckingEuclid.lemma_collinear_ABC_ABD_ABE_CDE.
Require Import ProofCheckingEuclid.lemma_collinear_ABC_ABD_BCD.
Require Import ProofCheckingEuclid.lemma_collinearorder.
Require Import ProofCheckingEuclid.lemma_s_n_col_ncol.
Require Import ProofCheckingEuclid.lemma_s_ncol_n_col.

Section Euclid.

Context `{Ax:euclidean_neutral_ruler_compass}.

Lemma lemma_NChelper :
	forall A B C P Q,
	nCol A B C ->
	Col A B P ->
	Col A B Q ->
	neq P Q ->
	nCol P Q C.
Proof.
	intros A B C P Q.
	intros nCol_A_B_C.
	intros Col_A_B_P.
	intros Col_A_B_Q.
	intros neq_P_Q.

	pose proof (lemma_NCdistinct _ _ _ nCol_A_B_C) as (neq_A_B & _ & _ & neq_B_A & _ & _).
	pose proof (lemma_s_ncol_n_col _ _ _ nCol_A_B_C) as n_Col_A_B_C.

	pose proof (lemma_collinear_ABC_ABD_BCD _ _ _ _ Col_A_B_P Col_A_B_Q neq_A_B) as Col_B_P_Q.
	pose proof (lemma_collinearorder _ _ _ Col_A_B_P) as (Col_B_A_P & _ & _ & _ & _).
	pose proof (lemma_collinearorder _ _ _ Col_A_B_Q) as (Col_B_A_Q & _ & _ & _ & _).

	pose proof (lemma_collinear_ABC_ABD_BCD _ _ _ _ Col_B_A_P Col_B_A_Q neq_B_A) as Col_A_P_Q.
	pose proof (lemma_collinearorder _ _ _ Col_A_P_Q) as (_ & Col_P_Q_A & _ & _ & _).

	pose proof (lemma_collinearorder _ _ _ Col_B_P_Q) as (_ & Col_P_Q_B & _ & _ & _).

	assert (~ Col P Q C) as n_Col_P_Q_C.
	{
		intros Col_P_Q_C.

		pose proof (lemma_collinear_ABC_ABD_ABE_CDE _ _ _ _ _ neq_P_Q Col_P_Q_A Col_P_Q_B Col_P_Q_C) as Col_A_B_C.

		contradict Col_A_B_C.
		exact n_Col_A_B_C.
	}
	pose proof (lemma_s_n_col_ncol _ _ _ n_Col_P_Q_C) as nCol_P_Q_C.

	exact nCol_P_Q_C.
Qed.

End Euclid.


(** 以下代码会预先导入关于整数的定义、证明以及自动证明指令。*)
Require Import Coq.ZArith.ZArith.
Require Import Coq.micromega.Psatz.
Local Open Scope Z.

(** * 归纳类型的又一个例子：二叉树 *)

Inductive tree: Type :=
| Leaf: tree
| Node (l: tree) (v: Z) (r: tree): tree.

(** 这个定义说的是，一棵二叉树要么是一棵空树_[Leaf]_，要么有一棵左子树、有一棵右
    子树外加有一个根节点整数标号。Coq中，我们往往可以使用递归函数定义归纳类型元
    素的性质。Coq中定义递归函数时使用的关键字是_[Fixpoint]_。下面的两个定义通过
    递归定义了二叉树的高度和节点个数。*)

Fixpoint tree_height (t: tree): Z :=
  match t with
  | Leaf => 0
  | Node l v r => Z.max (tree_height l) (tree_height r) + 1
  end.
Fixpoint tree_size (t: tree): Z :=
  match t with
  | Leaf => 0
  | Node l v r => tree_size l + tree_size r + 1
  end.

(** Coq中也可以定义树到树的函数。下面的_[tree_reverse]_函数把二叉树进行了左右翻转。 *)

Fixpoint tree_reverse (t: tree): tree :=
  match t with
  | Leaf => Leaf
  | Node l v r => Node (tree_reverse r) v (tree_reverse l)
  end.

(** 下面画出的是一个二叉树左右翻转的例子。如果_[t]_是左边的树，那么
    _[tree_reverse t]_的计算结果就是右边的树。*)

(**      5                5
        / \              / \
       3   9            9   3
          / \          / \
         8  100      100  8     *)

(** 这个例子中的树以及左右翻转的计算结果都可以在Coq中表示出来：*)

(** Coq表示 *)
Example tree_reverse_example:
  tree_reverse
    (Node
       (Node Leaf 3 Leaf)
       5
       (Node (Node Leaf 8 Leaf) 9 (Node Leaf 100 Leaf)))
  =
  Node
    (Node (Node Leaf 100 Leaf) 9 (Node Leaf 8 Leaf))
    5
    (Node Leaf 3 Leaf).
Proof. reflexivity. Qed.

(** * 结构归纳法证明 *)

(** 我们接下去将证明一些关于_[tree_height]_，_[tree_size]_与_[tree_reverse]_的基
    本性质。我们在证明中将会使用的主要方法是归纳法。*)

(** 相信大家都很熟悉自然数集上的数学归纳法。数学归纳法说的是：如果我们要证明某性
    质_[P]_对于任意自然数_[n]_都成立，那么我可以将证明分为如下两步：*)

(** 奠基步骤：证明_[P 0]_成立；*)
(** 归纳步骤：证明对于任意自然数_[n]_，如果_[P n]_成立，那么_[P (n + 1)]_也成
    立。*)

(** 对二叉树的归纳证明与上面的数学归纳法稍有不同。具体而言，如果我们要证明某性质
    _[P]_对于一切二叉树_[t]_都成立，那么我们只需要证明以下两个结论：*)

(** 奠基步骤：证明_[P Leaf]_成立；*)
(** 归纳步骤：证明对于任意二叉树_[l]_ _[r]_以及任意整数标签_[n]_，如果_[P l]_与
    _[P r]_都成立，那么_[P (Node l n r)]_也成立。*)

(** 这样的证明方法就成为结构归纳法。在Coq中，_[induction]_指令表示：使用结构归纳
    法。下面是几个证明的例子。*)

(** 第一个例子是证明_[tree_size]_与_[tree_reverse]_之间的关系。*)

Lemma reverse_size: forall t,
  tree_size (tree_reverse t) = tree_size t.
Proof.
  intros.
  induction t.
  (** 上面这个指令说的是：对_[t]_结构归纳。Coq会自动将原命题规约为两个证明目标，
      即奠基步骤和归纳步骤。为了增加Coq证明的可读性，我们推荐大家使用bullet记号
      把各个子证明过程分割开来，就像一个一个抽屉或者一个一个文件夹一样。Coq中可
      以使用的bullet标记有：_[+ - * ++ -- **]_ ...*)
  + simpl.
    (** 第一个分支是奠基步骤。这个_[simpl]_指令表示将结论中用到的递归函数根据定
        义化简。*)
    reflexivity.
  + simpl.
    (** 第二个分支是归纳步骤。我们看到证明目标中有两个前提_[IHt1]_以及_[IHt2]_。
        在英文中_[IH]_表示induction hypothesis的缩写，也就是归纳假设。在这个证明
        中_[IHt1]_与_[IHt2]_分别是左子树_[t1]_与右子树_[t2]_的归纳假设。 *)

    rewrite IHt1.
    rewrite IHt2.
    lia.
    (** 这个_[lia]_指令的全称是linear integer arithmatic，可以用来自动证明关于整
        数的线性不等式。*)
Qed.

(** 第二个例子很类似，是证明_[tree_height]_与_[tree_reverse]_之间的关系。*)

Lemma reverse_height: forall t,
  tree_height (tree_reverse t) = tree_height t.
Proof.
  intros.
  induction t.
  + simpl.
    reflexivity.
  + simpl.
    rewrite IHt1.
    rewrite IHt2.
    lia.
    (** 注意：这个_[lia]_指令也是能够处理_[Z.max]_与_[Z.min]_的。*)
Qed.

(** 下面我们将通过重写上面这一段证明，介绍Coq证明语言的一些其他功能。*)

Lemma reverse_height_attempt2: forall t,
  tree_height (tree_reverse t) = tree_height t.
Proof.
  intros.
  induction t; simpl.
  (** 在Coq证明语言中可以用分号将小的证明指令连接起来形成大的证明指令，其中
      _[tac1 ; tac2]_这个证明指令表示先执行指令_[tac1]_，再对于_[tac1]_生成的每
      一个证明目标执行_[tac2]_。分号是右结合的。*)
  + reflexivity.
  + simpl.
    lia.
    (** 此处的_[lia]_指令不仅可以处理结论中的整数线性运算，其自动证明过程中也会
        使用前提中关于整数线性运算的假设。*)
Qed.

(** 请各位同学证明下面结论。*)

Lemma reverse_involutive: forall t,
  tree_reverse (tree_reverse t) = t.
Proof.
Admitted. (** *)

Lemma reverse_inv: forall t1 t2,
  tree_reverse t1 = t2 ->
  t1 = tree_reverse t2.
Proof.
Admitted. (** *)

(** * 字符串 *)

(** 以下代码会预先导入关于ascii码与字符串的定义。*)
Require Import Coq.Strings.Ascii.
Require Import Coq.Strings.String.
Local Open Scope string.

(** 字符串的定义 *)
(** 下面Coq代码可以用于查看_[string]_在Coq中的定义。*)
Print string.
(** 查询结果如下。*)
(**
Inductive string :=
| EmptyString : string
| String : ascii -> string -> string. *)

(** 当然，Coq也提供了专门表达字符串的符号。*)

Check EmptyString.
Check "c".
Check "c"%char.
Check String "a"%char (String "b"%char EmptyString).

(** 查询结果 *)
(**
"": string
"c": string
"c"%char: ascii
"ab": string
*)

(** 所以，字符串这样的链状结构其实是树状结构的一种退化情况，也可以用Coq的归纳类
    型定义。下面我们可以定义字符串的拼接和取反。*)

Fixpoint string_app (s1 s2: string): string :=
  match s1 with
  | EmptyString => s2
  | String c s1' => String c (string_app s1' s2)
  end.

Fixpoint string_rev (s: string): string :=
  match s with
  | EmptyString => EmptyString
  | String c s' => string_app (string_rev s') (String c EmptyString)
  end.

(** 接下来我们就可以证明一些简单的性质。 *)

(** 引理_[string_app_assoc]_ *)
Lemma string_app_assoc: forall s1 s2 s3,
  string_app s1 (string_app s2 s3) =
  string_app (string_app s1 s2) s3.
Proof.
  intros.
  induction s1.
  + simpl.
    reflexivity.
  + simpl.
    rewrite IHs1.
    reflexivity.
Qed.

(** 引理_[string_app_empty_r]_ *)
Lemma string_app_empty_r: forall s,
  string_app s "" = s.
Proof.
  intros.
  induction s.
  + simpl.
    reflexivity.
  + simpl.
    rewrite IHs.
    reflexivity.
Qed.

(** 下面性质请大家自行证明 *)
Lemma string_rev_app: forall s1 s2,
  string_rev (string_app s1 s2) =
  string_app (string_rev s2) (string_rev s1).
Proof.
Admitted. (** *)

(** * 自然数 *)

(** 将字符串等链状结构进一步退化，就会得到Coq中自然数的定义。*)

(** 下面Coq代码可以用于查看_[nat]_在Coq中的定义。*)
Print nat.
(** 查询结果如下。*)
(**
Inductive nat := O : nat | S: nat -> nat. *)

(** 下面我们在Coq中去定义自然数的加法，并且也试着证明一条基本性质：加法交换律。*)

(** 由于Coq的标准库中已经定义了自然数以及自然数的加法。我们开辟一个_[NatDemo]_来
    开发我们自己的定义与证明。以免与Coq标准库的定义相混淆。*)
Module NatDemo.

(** 先定义自然数_[nat]_。*)

Inductive nat :=
| O : nat
| S (n: nat): nat.

(** 再定义自然数加法。*)

Fixpoint plus (n m: nat): nat :=
  match n with
  | O => m
  | S n' => S (plus n' m)
  end.

(** 下面证明加法交换律。*)

Theorem plus_comm: forall n m,
  plus n m = plus m n.
Proof.
Admitted. (** *)

End NatDemo.

(** * While + DB语言的语法树 *)

Module WhileDB.

(** 先定义变量名，我们规定不同的变量名就是不同的字符串。*)

Definition var_name: Type := string.

(** 再定义二元运算符和一元运算符。*)

Inductive binop : Type :=
  | OOr | OAnd
  | OLt | OLe | OGt | OGe | OEq | ONe
  | OPlus | OMinus | OMul | ODiv | OMod.

Inductive unop : Type :=
  | ONot | ONeg.

(** 下面是表达式的抽象语法树。*)

Inductive expr : Type :=
  | ENum (n : Z)
  | EVar (x : var_name)
  | EBinop (op: binop) (e1 e2 : expr)
  | EUnop (op: unop) (e: expr)
  | EDeref (e: expr)
  | EMalloc (e: expr)
  | EReadInt
  | EReadChar.

(** 下面是程序语句的抽象语法树。*)

Inductive com : Type :=
  | CDecl (x: var_name)
  | CAss (e1 e2: expr)
  | CSeq (c1 c2 : com)
  | CIf (e : expr) (c1 c2 : com)
  | CWhile (e : expr) (c : com).

(** 下面我们定义一项简单的程序变换：右结合变换。例如，将_[(c1;c2);c3]_变换为
    _[c1;(c2;c3)]_。*)

(** 首先，这里定义一个辅助函数，该函数假设_[c]_与_[c0]_已经是右结合的，计算
    _[c; c0]_转换后的结果*)
Fixpoint CSeq_right_assoc (c c0: com): com :=
  match c with
  | CSeq c1 c2 => CSeq c1 (CSeq_right_assoc c2 c0)
  | _ => CSeq c c0
  end.

(** 现在，可以在_[CSeq_right_assoc]_的基础上定义右结合变换_[right_assoc]_。*)
Fixpoint right_assoc (c: com): com :=
  match c with
  | CDecl x => CDecl x
  | CAss e1 e2 => CAss e1 e2
  | CSeq c1 c2 => CSeq_right_assoc (right_assoc c1) (right_assoc c2)
  | CIf e c1 c2 => CIf e (right_assoc c1) (right_assoc c2)
  | CWhile e c1 => CWhile e (right_assoc c1)
  end.

End WhileDB.


(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Unset Positivity Checking.
Unset Guard Checking.

Inductive nat : Set :=
| O : nat
| S : nat -> nat.

Inductive natural : Set :=
| Zero : natural
| Succ : natural -> natural.

Fixpoint plus (plus_arg0 : natural) (plus_arg1 : natural) {struct plus_arg0}
  : natural :=
  match plus_arg0 with
  | Zero => plus_arg1
  | Succ n => Succ (plus n plus_arg1)
  end.

Fixpoint mult (mult_arg0 : natural) (mult_arg1 : natural) {struct mult_arg0}
  : natural :=
  match mult_arg0 with
  | Zero => Zero
  | Succ n => plus (mult n mult_arg1) mult_arg1
  end.

Definition synth (lf3 : natural) (z : natural) (lf2 : natural) : natural :=
  plus lf3 (plus z lf2).


(**************************************************************************
* TLC: A library for Coq                                                  *
* Mathematical structures                                                 *
**************************************************************************)

Set Implicit Arguments.
Require Import LibTactics LibLogic LibOperation.
Generalizable Variables A B.

(* ********************************************************************** *)
(** * Monoids *)

Record monoid_def (A:Type) : Type := monoid_ {
   monoid_oper : oper2 A;
   monoid_neutral : A }.

Class Monoid (A:Type) (m:monoid_def A) : Prop := {
   monoid_assoc_prop : let (o,n) := m in assoc o;
   monoid_neutral_l_prop : let (o,n) := m in neutral_l o n;
   monoid_neutral_r_prop : let (o,n) := m in neutral_r o n }.

Section MonoidProp.
Context {A:Type} {m:monoid_def A}.
Class Monoid_assoc := {
  monoid_assoc : assoc (monoid_oper m) }.
Class Monoid_neutral_l := {
  monoid_neutral_l : neutral_l (monoid_oper m) (monoid_neutral m) }.
Class Monoid_neutral_r := {
  monoid_neutral_r : neutral_r (monoid_oper m) (monoid_neutral m) }.
End MonoidProp.

Section MonoidInst.
Context {A:Type} {m:monoid_def A} {M:Monoid m}.
Global Instance Monoid_Monoid_assoc : Monoid_assoc (m:=m).
Proof.
  constructor. destruct M as [U ? ?]. destruct m. simpl. apply U.
Qed.
Global Instance Monoid_Monoid_neutral_l : Monoid_neutral_l (m:=m).
Proof.
  constructor. destruct M as [? U ?]. destruct m. simpl. apply U.
Qed.
Global Instance Monoid_Monoid_neutral_r : Monoid_neutral_r (m:=m).
Proof.
  constructor. destruct M as [? ? U]. destruct m. simpl. apply U.
Qed.
End MonoidInst.


(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Unset Positivity Checking.
Unset Guard Checking.

Inductive nat : Set :=
| O : nat
| S : nat -> nat.

Inductive natural : Set :=
| Zero : natural
| Succ : natural -> natural.

Fixpoint plus (plus_arg0 : natural) (plus_arg1 : natural) {struct plus_arg0}
  : natural :=
  match plus_arg0 with
  | Zero => plus_arg1
  | Succ n => Succ (plus n plus_arg1)
  end.

Fixpoint mult (mult_arg0 : natural) (mult_arg1 : natural) {struct mult_arg0}
  : natural :=
  match mult_arg0 with
  | Zero => Zero
  | Succ n => plus (mult n mult_arg1) mult_arg1
  end.

Definition synth (lf3 : natural) (z : natural) (lf2 : natural) : natural :=
  plus z (plus lf3 lf2).


From mathcomp Require Import all_ssreflect.
(*
1 依存和
存在 (∃) は帰納型の特殊な例である．
*)
Print ex.
(*
Inductive ex (A : Type) (P : A -> Prop) : Prop :=
ex_intro : forall x : A, P x -> ex P.
*)

(*
ex (fun x:A => P(x)) を exists x:A, P(x) と書いてもいい．
この定義を見ると，ex P = ∃x, P(x) は x と P(x) の対でしかない．
対の第 2 要素に第 1 要素が現れているので，この積を「依存和」という．
（元々依存のある関数型を定義域を添字とした依存積と見なすなら，
こちらは A を添字とする直和集合になる）
既に見ているように，証明の中で依存和を構築する時に，exists という作戦を使う．
 *)

Lemma exists_pred x : x > 0 -> exists y, x = S y.
Proof.
case x => // n _. (* case: x と同じだが項が読みやすい *)
by exists n.
Qed.
Print exists_pred.
(*
exists_pred =
fun x : nat =>
match x as n return (0 < n -> exists y : nat, n = y.+1) with
| 0 =>
  fun H : 0 < 0 =>
  let H0 : False :=
    eq_ind (0 < 0) (fun e : bool => if e then False else True) I true H in
  False_ind (exists y : nat, 0 = y.+1) H0 (* 0 はありえない *)
| n.+1 =>
fun _ : 0 < n.+1 => ex_intro (fun y : nat => n.+1 = y.+1) n (erefl n.+1)
end (* n.+1 のとき n を返す *)
    : forall x : nat, 0 < x -> exists y : nat, x = y.+1
*)
Require Extraction.
Extraction exists_pred. (* 何も抽出されない *)
(*
上記の ex は Prop に住むものなので，論理式の中でしか使えない．しかし，プログラムの中で
依存和を使いたい時もある．この時には sig を使う．
*)
Print sig.

(* Inductive sig (A : Type) (P : A -> Prop) : Type :=
 exist : forall x : A, P x -> sig P. *)
(*
sig (fun x:T => Px) は {x:T | Px} とも書く．ex と同様に，
具体的な値は exists で指定する．
こういう条件付きな値を扱う安全な関数が書ける．
*)
Definition safe_pred x : x > 0 -> {y | x = S y}.
case x => // n _. (* exists_pred と同じ *)
by exists n. (* こちらも exists を使う *)
Defined. (* 定義を透明にし，計算に使えるようにする *)

(* 証明された関数を OCaml の関数として輸出できる．その場合，Prop の部分が消される．*)
Require Extraction.

Extraction safe_pred.
(** val safe_pred : nat -> nat **)
(*
let safe_pred = function
| O -> assert false (* absurd case *)
| S x’ -> x’
 *)

(*
2 Hint と auto
証明が冗長になることが多い．auto は簡単な規則で証明を補完しようとする．
具体的には，autoは 仮定や Hint lem1 lem2 ... で登録した定理を
applyで適用しようとする．
これらを組み合わせて，深さ 5 の項まで作れる (auto n で深さ n にできる)．
info auto で使われたヒントを表示させる事もできる．
Hint Constructors で帰納型を登録すると，各構成子が定理として登録される．また，auto
using lem1, lem2, ... で一回だけヒントを追加することもできる．
auto で定理が適用されるために，全ての変数が定理の結論に現れる必要がある．eauto を使う
と simple apply が eapply に変わるので，決まらない変数が変数のまま残せる．
その代わり，可能な導出木が増えるので，探索が中々終わらない場合もある．
*)

(*
3 整列の証明
 *)

Section Sort.
  Variables (A:Set) (le:A->A->bool). (* データ型 A とのその順序 le *)
  (* 既に整列されたリスト l の中に a を挿入する *)
  Fixpoint insert a (l: list A) :=
    match l with
    | nil => (a :: nil)
    | b :: l' => if le a b then a :: l else b :: insert a l'
    end.

  (* 繰り返しの挿入でリスト l を整列する *)
  Fixpoint isort (l : list A) : list A :=
    match l with
    | nil => nil
    | a :: l' => insert a (isort l')
    end.

  (* le は推移律と完全性をみたす *)
  Hypothesis le_trans: forall x y z, le x y -> le y z -> le x z.
  Hypothesis le_total: forall x y, ~~ le x y -> le y x.

  (* le_list x l : x はあるリスト l の全ての要素以下である *)
  Inductive le_list x : list A -> Prop :=
  | le_nil : le_list x nil
  | le_cons : forall y l,
      le x y -> le_list x l -> le_list x (y::l).

  (* sorted l : リスト l は整列されている *)
  Inductive sorted : list A -> Prop :=
  | sorted_nil : sorted nil
  | sorted_cons : forall a l,
      le_list a l -> sorted l -> sorted (a::l).

Hint Constructors le_list sorted. (* auto の候補にする *)
Lemma le_list_insert a b l :
le a b -> le_list a l -> le_list a (insert b l).
Proof.
  move=> leab; elim => {l} [|c l] /=. info_auto.
  case: ifPn. info_auto. info_auto.
Qed.

Lemma le_list_trans a b l :
le a b -> le_list b l -> le_list a l.
Proof.
  move=> leab; elim. info_auto.
  info_eauto using le_trans. (* 推移律は eauto が必要 *)
Qed.

Hint Resolve le_list_insert le_list_trans. (* 補題も候補に加える *)
Theorem insert_ok a l : sorted l -> sorted (insert a l). Admitted.
Theorem isort_ok l : sorted (isort l). Admitted.

(* Permutation l1 l2 : リスト l2 は l1 の置換である *)
Inductive Permutation : list A -> list A -> Prop :=
| perm_nil: Permutation nil nil
| perm_skip: forall x l l',
    Permutation l l' -> Permutation (x::l) (x::l')
| perm_swap: forall x y l, Permutation (y::x::l) (x::y::l)
| perm_trans: forall l l' l'',
    Permutation l l' ->
    Permutation l' l'' -> Permutation l l''.
Hint Constructors Permutation.

Theorem Permutation_refl l : Permutation l l. Admitted.
Theorem insert_perm l a : Permutation (a :: l) (insert a l). Admitted.
Theorem isort_perm l : Permutation l (isort l). Admitted.

(* 証明付き整列関数 *)
Definition safe_isort l : {l'|sorted l' /\ Permutation l l'}.
exists (isort l).
auto using isort_ok, isort_perm.
Defined.
Print safe_isort.
End Sort.
Check safe_isort. (* le と必要な補題を与えなければならない *)
Extraction leq. (* mathcomp の eqType の抽出が汚ない *)
Definition leq' m n := if m - n is 0 then true else false.
Extraction leq'. (* こちらはすっきりする *)

Lemma leq'E m n : leq' m n = (m <= n).
Proof. rewrite /leq' /leq. by case: (m-n). Qed.

Lemma leq'_trans m n p : leq' m n -> leq' n p -> leq' m p.
Proof. rewrite !leq'E; apply leq_trans. Qed.

Lemma leq'_total m n : ~~ leq' m n -> leq n m. Admitted.

Definition isort_leq := safe_isort nat leq' leq'_trans leq'_total.
Eval compute in proj1_sig (isort_leq (3 :: 1 :: 2 :: 0 :: nil)).
= [:: 0; 1; 2; 3] : seq nat
Extraction "isort.ml" isort_leq.

(* 練習問題 3.1
1. Admitted を Proof に変え，証明を完成させよ．
2. le list を以下のように一般化できる.
Inductive All (P : A -> Prop) : list A -> Prop :=
| All_nil : All P nil
| All_cons : forall y l, P y -> All P l -> All P (y::l).
このとき，All (le a) l が le list a l と同じ意味になる．
こちらを使うように証明を修正せよ．*)


(** * ProofObjects: The Curry-Howard Correspondence *)

Set Warnings "-notation-overridden,-parsing".
From LF Require Export IndProp.

(** "_Algorithms are the computational content of proofs_."
    --Robert Harper *)

(** We have seen that Coq has mechanisms both for _programming_,
    using inductive data types like [nat] or [list] and functions over
    these types, and for _proving_ properties of these programs, using
    inductive propositions (like [eveni]), implication, universal
    quantification, and the like.  So far, we have mostly treated
    these mechanisms as if they were quite separate, and for many
    purposes this is a good way to think.  But we have also seen hints
    that Coq's programming and proving facilities are closely related.
    For example, the keyword [Inductive] is used to declare both data
    types and propositions, and [->] is used both to describe the type
    of functions on data and logical implication.  This is not just a
    syntactic accident!  In fact, programs and proofs in Coq are
    almost the same thing.  In this chapter we will study how this
    works.

    We have already seen the fundamental idea: provability in Coq is
    represented by concrete _evidence_.  When we construct the proof
    of a basic proposition, we are actually building a tree of
    evidence, which can be thought of as a data structure.

    If the proposition is an implication like [A -> B], then its proof
    will be an evidence _transformer_: a recipe for converting
    evidence for A into evidence for B.  So at a fundamental level,
    proofs are simply programs that manipulate evidence. *)

(** Question: If evidence is data, what are propositions themselves?

    Answer: They are types! *)

(** Look again at the formal definition of the [eveni] property.  *)

Print eveni.
(* ==>
  Inductive eveni : nat -> Prop :=
    | eveni_0 : eveni 0
    | eveni_SS : forall n, eveni n -> eveni (S (S n)).
*)

(** Suppose we introduce an alternative pronunciation of "[:]".
    Instead of "has type," we can say "is a proof of."  For example,
    the second line in the definition of [eveni] declares that [eveni_0 : eveni
    0].  Instead of "[eveni_0] has type [eveni 0]," we can say that "[eveni_0]
    is a proof of [eveni 0]." *)

(** This pun between types and propositions -- between [:] as "has type"
    and [:] as "is a proof of" or "is evidence for" -- is called the
    _Curry-Howard correspondence_.  It proposes a deep connection
    between the world of logic and the world of computation:

                 propositions  ~  types
                 proofs        ~  data values

    See [Wadler 2015] (in Bib.v) for a brief history and up-to-date
    exposition. *)

(** Many useful insights follow from this connection.  To begin with,
    it gives us a natural interpretation of the type of the [eveni_SS]
    constructor: *)

Check eveni_SS
  : forall n,
    eveni n ->
    eveni (S (S n)).

(** This can be read "[eveni_SS] is a constructor that takes two
    arguments -- a number [n] and evidence for the proposition [eveni
    n] -- and yields evidence for the proposition [eveni (S (S n))]." *)

(** Now let's look again at a previous proof involving [eveni]. *)

Theorem eveni_4 : eveni 4.
Proof.
  apply eveni_SS. apply eveni_SS. apply eveni_0. Qed.

(** As with ordinary data values and functions, we can use the [Print]
    command to see the _proof object_ that results from this proof
    script. *)

Print eveni_4.
(* ===> eveni_4 = eveni_SS 2 (eveni_SS 0 eveni_0)
      : eveni 4  *)

(** Indeed, we can also write down this proof object directly,
    without the need for a separate proof script: *)

Check (eveni_SS 2 (eveni_SS 0 eveni_0))
  : eveni 4.

(** The expression [eveni_SS 2 (eveni_SS 0 eveni_0)] can be thought of as
    instantiating the parameterized constructor [eveni_SS] with the
    specific arguments [2] and [0] plus the corresponding proof
    objects for its premises [eveni 2] and [eveni 0].  Alternatively, we can
    think of [eveni_SS] as a primitive "evidence constructor" that, when
    applied to a particular number, wants to be further applied to
    evidence that this number is even; its type,

      forall n, eveni n -> eveni (S (S n)),

    expresses this functionality, in the same way that the polymorphic
    type [forall X, list X] expresses the fact that the constructor
    [nil] can be thought of as a function from types to empty lists
    with elements of that type. *)

(** We saw in the [Logic] chapter that we can use function
    application syntax to instantiate universally quantified variables
    in lemmas, as well as to supply evidence for assumptions that
    these lemmas impose.  For instance: *)

Theorem eveni_4': eveni 4.
Proof.
  apply (eveni_SS 2 (eveni_SS 0 eveni_0)).
Qed.

(* ################################################################# *)
(** * Proof Scripts *)

(** The _proof objects_ we've been discussing lie at the core of how
    Coq operates.  When Coq is following a proof script, what is
    happening internally is that it is gradually constructing a proof
    object -- a term whose type is the proposition being proved.  The
    tactics between [Proof] and [Qed] tell it how to build up a term
    of the required type.  To see this process in action, let's use
    the [Show Proof] command to display the current state of the proof
    tree at various points in the following tactic proof. *)

Theorem eveni_4'' : eveni 4.
Proof.
  Show Proof.
  apply eveni_SS.
  Show Proof.
  apply eveni_SS.
  Show Proof.
  apply eveni_0.
  Show Proof.
Qed.

(** At any given moment, Coq has constructed a term with a
    "hole" (indicated by [?Goal] here, and so on), and it knows what
    type of evidence is needed to fill this hole.

    Each hole corresponds to a subgoal, and the proof is
    finished when there are no more subgoals.  At this point, the
    evidence we've built is stored in the global context under the name
    given in the [Theorem] command. *)

(** Tactic proofs are useful and convenient, but they are not
    essential: in principle, we can always construct the required
    evidence by hand, as shown above. Then we can use [Definition]
    (rather than [Theorem]) to give a global name directly to this
    evidence. *)

Definition eveni_4''' : eveni 4 :=
  eveni_SS 2 (eveni_SS 0 eveni_0).

(** All these different ways of building the proof lead to exactly the
    same evidence being saved in the global environment. *)

Print eveni_4.
(* ===> eveni_4    =   eveni_SS 2 (eveni_SS 0 eveni_0) : eveni 4 *)
Print eveni_4'.
(* ===> eveni_4'   =   eveni_SS 2 (eveni_SS 0 eveni_0) : eveni 4 *)
Print eveni_4''.
(* ===> eveni_4''  =   eveni_SS 2 (eveni_SS 0 eveni_0) : eveni 4 *)
Print eveni_4'''.
(* ===> eveni_4''' =   eveni_SS 2 (eveni_SS 0 eveni_0) : eveni 4 *)

(** **** Exercise: 2 stars, standard (eight_is_even)

    Give a tactic proof and a proof object showing that [eveni 8]. *)

Theorem eveni_8 : eveni 8.
Proof.
  (* FILL IN HERE *) Admitted.

Definition eveni_8' : eveni 8
  (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.
(** [] *)

(* ################################################################# *)
(** * Quantifiers, Implications, Functions *)

(** In Coq's computational universe (where data structures and
    programs live), there are two sorts of values that have arrows in
    their types: _constructors_ introduced by [Inductive]ly defined
    data types, and _functions_.

    Similarly, in Coq's logical universe (where we carry out proofs),
    there are two ways of giving evidence for an implication:
    constructors introduced by [Inductive]ly defined propositions,
    and... functions! *)

(** For example, consider this statement: *)

Theorem eveni_plus4 : forall n, eveni n -> eveni (4 + n).
Proof.
  intros n H. simpl.
  apply eveni_SS.
  apply eveni_SS.
  apply H.
Qed.

(** What is the proof object corresponding to [eveni_plus4]?

    We're looking for an expression whose _type_ is [forall n, eveni n ->
    eveni (4 + n)] -- that is, a _function_ that takes two arguments (one
    number and a piece of evidence) and returns a piece of evidence!

    Here it is: *)

Definition eveni_plus4' : forall n, eveni n -> eveni (4 + n) :=
  fun (n : nat) => fun (H : eveni n) =>
    eveni_SS (S (S n)) (eveni_SS n H).

(** Recall that [fun n => blah] means "the function that, given [n],
    yields [blah]," and that Coq treats [4 + n] and [S (S (S (S n)))]
    as synonyms. Another equivalent way to write this definition is: *)

Definition eveni_plus4'' (n : nat) (H : eveni n)
                    : eveni (4 + n) :=
  eveni_SS (S (S n)) (eveni_SS n H).

Check eveni_plus4''
  : forall n : nat,
    eveni n ->
    eveni (4 + n).

(** When we view the proposition being proved by [eveni_plus4] as a
    function type, one interesting point becomes apparent: The second
    argument's type, [eveni n], mentions the _value_ of the first
    argument, [n].

    While such _dependent types_ are not found in conventional
    programming languages, they can be useful in programming too, as
    the recent flurry of activity in the functional programming
    community demonstrates. *)

(** Notice that both implication ([->]) and quantification ([forall])
    correspond to functions on evidence.  In fact, they are really the
    same thing: [->] is just a shorthand for a degenerate use of
    [forall] where there is no dependency, i.e., no need to give a
    name to the type on the left-hand side of the arrow:

           forall (x:nat), nat
        =  forall (_:nat), nat
        =  nat -> nat
*)

(** For example, consider this proposition: *)

Definition eveni_plus2 : Prop :=
  forall n, forall (E : eveni n), eveni (n + 2).

(** A proof term inhabiting this proposition would be a function
    with two arguments: a number [n] and some evidence [E] that [n] is
    even.  But the name [E] for this evidence is not used in the rest
    of the statement of [eveni_plus2], so it's a bit silly to bother
    making up a name for it.  We could write it like this instead,
    using the dummy identifier [_] in place of a real name: *)

Definition eveni_plus2' : Prop :=
  forall n, forall (_ : eveni n), eveni (n + 2).

(** Or, equivalently, we can write it in a more familiar way: *)

Definition eveni_plus2'' : Prop :=
  forall n, eveni n -> eveni (n + 2).

(** In general, "[P -> Q]" is just syntactic sugar for
    "[forall (_:P), Q]". *)

(* ################################################################# *)
(** * Programming with Tactics *)

(** If we can build proofs by giving explicit terms rather than
    executing tactic scripts, you may be wondering whether we can
    build _programs_ using _tactics_ rather than explicit terms.
    Naturally, the answer is yes! *)

Definition add1 : nat -> nat.
intro n.
Show Proof.
apply S.
Show Proof.
apply n. Defined.

Print add1.
(* ==>
    add1 = fun n : nat => S n
         : nat -> nat
*)

Compute add1 2.
(* ==> 3 : nat *)

(** Notice that we terminate the [Definition] with a [.] rather than
    with [:=] followed by a term.  This tells Coq to enter _proof
    scripting mode_ to build an object of type [nat -> nat].  Also, we
    terminate the proof with [Defined] rather than [Qed]; this makes
    the definition _transparent_ so that it can be used in computation
    like a normally-defined function.  ([Qed]-defined objects are
    opaque during computation.)

    This feature is mainly useful for writing functions with dependent
    types, which we won't explore much further in this book.  But it
    does illustrate the uniformity and orthogonality of the basic
    ideas in Coq. *)

(* ################################################################# *)
(** * Logical Connectives as Inductive Types *)

(** Inductive definitions are powerful enough to express most of the
    connectives we have seen so far.  Indeed, only universal
    quantification (with implication as a special case) is built into
    Coq; all the others are defined inductively.  We'll see these
    definitions in this section. *)

Module Props.

(* ================================================================= *)
(** ** Conjunction *)

(** To prove that [P /\ Q] holds, we must present evidence for both
    [P] and [Q].  Thus, it makes sense to define a proof object for [P
    /\ Q] as consisting of a pair of two proofs: one for [P] and
    another one for [Q]. This leads to the following definition. *)

Module And.

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

Arguments conj [P] [Q].

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

(** Notice the similarity with the definition of the [prod] type,
    given in chapter [Poly]; the only difference is that [prod] takes
    [Type] arguments, whereas [and] takes [Prop] arguments. *)

Print prod.
(* ===>
   Inductive prod (X Y : Type) : Type :=
   | pair : X -> Y -> X * Y. *)

(** This similarity should clarify why [destruct] and [intros]
    patterns can be used on a conjunctive hypothesis.  Case analysis
    allows us to consider all possible ways in which [P /\ Q] was
    proved -- here just one (the [conj] constructor). *)

Theorem proj1' : forall P Q,
    P /\ Q -> P.
Proof.
  intros P Q HPQ. destruct HPQ as [HP HQ]. apply HP.
  Show Proof.
Qed.

(** Similarly, the [split] tactic actually works for any inductively
    defined proposition with exactly one constructor.  In particular,
    it works for [and]: *)

Lemma and_comm : forall P Q : Prop, P /\ Q <-> Q /\ P.
Proof.
  intros P Q. split.
  - intros [HP HQ]. split.
    + apply HQ.
    + apply HP.
  - intros [HQ HP]. split.
    + apply HP.
    + apply HQ.
Qed.

End And.

(** This shows why the inductive definition of [and] can be
    manipulated by tactics as we've been doing.  We can also use it to
    build proofs directly, using pattern-matching.  For instance: *)

Definition and_comm'_aux P Q (H : P /\ Q) : Q /\ P :=
  match H with
  | conj HP HQ => conj HQ HP
  end.

Definition and_comm' P Q : P /\ Q <-> Q /\ P :=
  conj (and_comm'_aux P Q) (and_comm'_aux Q P).

(** **** Exercise: 2 stars, standard (conj_fact)

    Construct a proof object for the following proposition. *)

Definition conj_fact : forall P Q R, P /\ Q -> Q /\ R -> P /\ R
  (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.
(** [] *)

(* ================================================================= *)
(** ** Disjunction *)

(** The inductive definition of disjunction uses two constructors, one
    for each side of the disjunct: *)

Module Or.

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

Arguments or_introl [P] [Q].
Arguments or_intror [P] [Q].

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

(** This declaration explains the behavior of the [destruct] tactic on
    a disjunctive hypothesis, since the generated subgoals match the
    shape of the [or_introl] and [or_intror] constructors.

    Once again, we can also directly write proof objects for theorems
    involving [or], without resorting to tactics. *)

Definition inj_l : forall (P Q : Prop), P -> P \/ Q :=
  fun P Q HP => or_introl HP.

Theorem inj_l' : forall (P Q : Prop), P -> P \/ Q.
Proof.
  intros P Q HP. left. apply HP.
Qed.

Definition or_elim : forall (P Q R : Prop), (P \/ Q) -> (P -> R) -> (Q -> R) -> R :=
  fun P Q R HPQ HPR HQR =>
    match HPQ with
    | or_introl HP => HPR HP
    | or_intror HQ => HQR HQ
    end.

Theorem or_elim' : forall (P Q R : Prop), (P \/ Q) -> (P -> R) -> (Q -> R) -> R.
Proof.
  intros P Q R HPQ HPR HQR.
  destruct HPQ as [HP | HQ].
  - apply HPR. apply HP.
  - apply HQR. apply HQ.
Qed.

End Or.

(** **** Exercise: 2 stars, standard (or_commut')

    Construct a proof object for the following proposition. *)

Definition or_commut' : forall P Q, P \/ Q -> Q \/ P
  (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.
(** [] *)

(* ================================================================= *)
(** ** Existential Quantification *)

(** To give evidence for an existential quantifier, we package a
    witness [x] together with a proof that [x] satisfies the property
    [P]: *)

Module Ex.

Inductive ex {A : Type} (P : A -> Prop) : Prop :=
| ex_intro : forall x : A, P x -> ex P.

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

End Ex.

(** This may benefit from a little unpacking.  The core definition is
    for a type former [ex] that can be used to build propositions of
    the form [ex P], where [P] itself is a _function_ from witness
    values in the type [A] to propositions.  The [ex_intro]
    constructor then offers a way of constructing evidence for [ex P],
    given a witness [x] and a proof of [P x].

    The notation in the standard library is a slight variant of
    the above, enabling syntactic forms such as [exists x y, P x y]. *)

(** The more familiar form [exists x, P x] desugars to an expression
    involving [ex]: *)

Check ex (fun n => eveni n) : Prop.

(** Here's how to define an explicit proof object involving [ex]: *)

Definition some_nat_is_even : exists n, eveni n :=
  ex_intro eveni 4 (eveni_SS 2 (eveni_SS 0 eveni_0)).

(** **** Exercise: 2 stars, standard (ex_eveni_Sn)

    Construct a proof object for the following proposition. *)

Definition ex_eveni_Sn : ex (fun n => eveni (S n))
  (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.
(** [] *)

(* ================================================================= *)
(** ** [True] and [False] *)

(** The inductive definition of the [True] proposition is simple: *)

Inductive True : Prop :=
  | I : True.

(** It has one constructor (so every proof of [True] is the same, so
    being given a proof of [True] is not informative.) *)

(** **** Exercise: 1 star, standard (p_implies_true)

    Construct a proof object for the following proposition. *)

Definition p_implies_true : forall P, P -> True
  (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.
(** [] *)

(** [False] is equally simple -- indeed, so simple it may look
    syntactically wrong at first glance! *)

Inductive False : Prop := .

(** That is, [False] is an inductive type with _no_ constructors --
    i.e., no way to build evidence for it. For example, there is
    no way to complete the following definition such that it
    succeeds (rather than fails). *)

Fail Definition contra : False :=
  0 = 1.

(** But it is possible to destruct [False] by pattern matching. There can
    be no patterns that match it, since it has no constructors.  So
    the pattern match also is so simple it may look syntactically
    wrong at first glance. *)

Definition false_implies_zero_eq_one : False -> 0 = 1 :=
  fun contra => match contra with end.

(** Since there are no branches to evaluate, the [match] expression
    can be considered to have any type we want, including [0 = 1].
    Indeed, it's impossible to ever cause the [match] to be evaluated,
    because we can never construct a value of type [False] to pass to
    the function. *)

(** **** Exercise: 1 star, standard (ex_falso_quodlibet')

    Construct a proof object for the following proposition. *)

Definition ex_falso_quodlibet' : forall P, False -> P
  (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.
(** [] *)

End Props.

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

(** Even Coq's equality relation is not built in.  We can define
    it ourselves: *)

Module MyEquality.

Inductive eq {X:Type} : X -> X -> Prop :=
| eq_refl : forall x, eq x x.

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

(** The way to think about this definition (which is just a slight
    variant of the standard library's) 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 [eq_refl] to a type [X] and a single value [x : X],
    which yields evidence that [x] is equal to [x].

    Other types of the form [eq x y] where [x] and [y] are not the
    same are thus uninhabited. *)

(** We can use [eq_refl] to construct evidence that, for example, [2 =
    2].  Can we also use it to construct evidence that [1 + 1 = 2]?
    Yes, we can.  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 [Compute], include
    evaluation of function application, inlining of definitions, and
    simplification of [match]es.  *)

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

(** The [reflexivity] tactic that we have used to prove
    equalities up to now is essentially just shorthand for [apply
    eq_refl].

    In tactic-based proofs of equality, the conversion rules are
    normally hidden in uses of [simpl] (either explicit or implicit in
    other tactics such as [reflexivity]).

    But you can see them directly at work in the following explicit
    proof objects: *)

Definition four' : 2 + 2 == 1 + 3 :=
  eq_refl 4.

Definition singleton : forall (X:Type) (x:X), []++[x] == x::[]  :=
  fun (X:Type) (x:X) => eq_refl [x].

(** **** Exercise: 2 stars, standard (equality__leibniz_equality)

    The inductive definition of equality implies _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 equality__leibniz_equality : forall (X : Type) (x y: X),
  x == y -> forall P:X->Prop, P x -> P y.
Proof.
(* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 3 stars, standard, optional (leibniz_equality__equality)

    Show that, in fact, the inductive definition of equality is
    _equivalent_ to Leibniz equality.  Hint: the proof is quite short;
    about all you need to do is to invent a clever property [P] to
    instantiate the antecedent.*)

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

(** [] *)

End MyEquality.

(* ================================================================= *)
(** ** Inversion, Again *)

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

(* ################################################################# *)
(** * The Coq Trusted Computing Base *)

(** One issue that arises with any automated proof assistant is
    "why trust it?": what if there is a bug in the implementation that
    renders all its reasoning suspect?

    While it is impossible to allay such concerns completely, the fact
    that Coq is based on the Curry-Howard correspondence gives it a
    strong foundation. Because propositions are just types and proofs
    are just terms, checking that an alleged proof of a proposition is
    valid just amounts to _type-checking_ the term.  Type checkers are
    relatively small and straightforward programs, so the "trusted
    computing base" for Coq -- the part of the code that we have to
    believe is operating correctly -- is small too.

    What must a typechecker do?  Its primary job is to make sure that
    in each function application the expected and actual argument
    types match, that the arms of a [match] expression are constructor
    patterns belonging to the inductive type being matched over and
    all arms of the [match] return the same type, and so on. *)

(** There are a few additional wrinkles:

    First, since Coq types can themselves be expressions, the checker
    must normalize these (by using the computation rules) before
    comparing them.

    Second, the checker must make sure that [match] expressions are
    _exhaustive_.  That is, there must be an arm for every possible
    constructor.  To see why, consider the following alleged proof
    object: *)

Fail Definition or_bogus : forall P Q, P \/ Q -> P :=
  fun (P Q : Prop) (A : P \/ Q) =>
    match A with
    | or_introl H => H
    end.

(** All the types here match correctly, but the [match] only
    considers one of the possible constructors for [or].  Coq's
    exhaustiveness check will reject this definition.

    Third, the checker must make sure that each recursive function
    terminates.  It does this using a syntactic check to make sure
    that each recursive call is on a subexpression of the original
    argument.  To see why this is essential, consider this alleged
    proof: *)

Fail Fixpoint infinite_loop {X : Type} (n : nat) {struct n} : X :=
  infinite_loop n.
Fail Definition falso : False := infinite_loop 0.

(** Recursive function [infinite_loop] purports to return a
    value of any type [X] that you would like.  (The [struct]
    annotation on the function tells Coq that it recurses on argument
    [n], not [X].)  Were Coq to allow [infinite_loop], then [falso]
    would be definable, thus giving evidence for [False].  So Coq rejects
    [infinite_loop]. *)

(** Note that the soundness of Coq depends only on the
    correctness of this typechecking engine, not on the tactic
    machinery.  If there is a bug in a tactic implementation (and this
    certainly does happen!), that tactic might construct an invalid
    proof term.  But when you type [Qed], Coq checks the term for
    validity from scratch.  Only theorems whose proofs pass the
    type-checker can be used in further proof developments.  *)

(* 2020-10-01 11:26 *)


(* --------------------------------------------------------------------
 * Copyright (c) - 2006--2012 - IMDEA Software Institute
 * Copyright (c) - 2006--2012 - Inria
 * Copyright (c) - 2006--2012 - Microsoft Coprporation
 *
 * Distributed under the terms of the CeCILL-B-V1 license
 * -------------------------------------------------------------------- *)

(*************************************************************)
(*      This file is distributed under the terms of the      *)
(*      GNU Lesser General Public License Version 2.1        *)
(*************************************************************)
(*    Benjamin.Gregoire@inria.fr Laurent.Thery@inria.fr      *)
(*************************************************************)

(************************************************************************

    Definition of the Euler Totient function

*************************************************************************)
Require Import ZArith.
Require Export Znumtheory.
Require Import Tactic.
Require Export ZSum.
Require Import ZAux.

Open Scope Z_scope.

Definition phi n := Zsum 1 (n - 1) (fun x => if rel_prime_dec x n then 1 else 0).

Theorem phi_def_with_0:
  forall n, 1< n -> phi n = Zsum 0 (n - 1) (fun x => if rel_prime_dec x n then 1 else 0).
intros n H; rewrite Zsum_S_left; auto with zarith.
case (rel_prime_dec 0 n); intros H2.
contradict H2; apply not_rel_prime_0; auto.
rewrite Zplus_0_l; auto.
Qed.

Theorem phi_pos: forall n, 1 < n -> 0 < phi n.
intros n H; unfold phi.
case (Zle_lt_or_eq 2 n); auto with zarith; intros H1; subst.
rewrite Zsum_S_left; simpl; auto with zarith.
case (rel_prime_dec 1 n); intros H2.
apply Zlt_le_trans with (1 + 0); auto with zarith.
apply Zplus_le_compat_l.
pattern 0 at 1; replace 0 with  ((1 + (n - 1) - 2) * 0); auto with zarith.
rewrite <- Zsum_c; auto with zarith.
apply Zsum_le; auto with zarith.
intros x H3;  case (rel_prime_dec x n); auto with zarith.
case H2; apply rel_prime_1; auto with zarith.
rewrite Zsum_nn.
case (rel_prime_dec (2 - 1) 2); auto with zarith.
intros H1; contradict H1; apply rel_prime_1; auto with zarith.
Qed.

Theorem phi_le_n_minus_1: forall n, 1 < n -> phi n <= n - 1.
intros n H; replace (n-1) with ((1 +  (n - 1) - 1) * 1); auto with zarith.
rewrite <- Zsum_c; auto with zarith.
unfold phi; apply Zsum_le; auto with zarith.
intros x H1; case (rel_prime_dec x n); auto with zarith.
Qed.

Theorem prime_phi_n_minus_1: forall n, prime n -> phi n = n - 1.
intros n H; replace (n-1) with ((1 +  (n - 1) - 1) * 1); auto with zarith.
assert (Hu: 1 <= n - 1).
assert (2 <= n); auto with zarith.
apply prime_le_2; auto.
rewrite <- Zsum_c; auto with zarith; unfold phi; apply Zsum_ext; auto.
intros x  (H2, H3); case H; clear H; intros H H1.
generalize (H1 x); case (rel_prime_dec x n); auto with zarith.
intros H6 H7; contradict H6; apply H7; split; auto with zarith.
Qed.

Theorem phi_n_minus_1_prime: forall n, 1 < n -> phi n = n - 1 -> prime n.
intros n H H1; case (prime_dec n); auto; intros H2.
assert (H3: phi n < n - 1); auto with zarith.
replace (n-1) with ((1 +  (n - 1) - 1) * 1); auto with zarith.
assert (Hu: 1 <= n - 1); auto with zarith.
rewrite <- Zsum_c; auto with zarith; unfold phi; apply Zsum_lt; auto.
intros x _; case (rel_prime_dec x n); auto with zarith.
case not_prime_divide with n; auto.
intros x (H3, H4); exists x; repeat split; auto with zarith.
case (rel_prime_dec x n); auto with zarith.
intros H5; absurd (x = 1 \/ x = -1); auto with zarith.
case (Zis_gcd_unique  x n x 1); auto.
apply Zis_gcd_intro; auto; exists 1; auto with zarith.
apply Zis_gcd_sym; exact H5.
contradict H3; rewrite H1; auto with zarith.
Qed.

Theorem phi_divide_prime: forall n, 1 < n -> (n - 1 | phi n) -> prime n.
intros n H1 H2; apply  phi_n_minus_1_prime; auto.
apply Zle_antisym.
apply phi_le_n_minus_1; auto.
apply Zdivide_le; auto; auto with zarith.
apply phi_pos; auto.
Qed.


(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Unset Positivity Checking.
Unset Guard Checking.

Inductive nat : Set :=
| O : nat
| S : nat -> nat.

Inductive natural : Set :=
| Zero : natural
| Succ : natural -> natural.

Fixpoint plus (plus_arg0 : natural) (plus_arg1 : natural) {struct plus_arg0}
  : natural :=
  match plus_arg0 with
  | Zero => plus_arg1
  | Succ n => Succ (plus n plus_arg1)
  end.

Fixpoint mult (mult_arg0 : natural) (mult_arg1 : natural) {struct mult_arg0}
  : natural :=
  match mult_arg0 with
  | Zero => Zero
  | Succ n => plus (mult n mult_arg1) mult_arg1
  end.

Definition synth (y : natural) (lf1 : natural) : natural :=
  plus Zero (plus lf1 y).


(** * Perm: Basic techniques for permutations and ordering *)

(** Consider these algorithms and data structures:
 - sort a sequence of numbers;
 - finite maps from numbers to (arbitrary-type) data
 - finite maps from any ordered type to (arbitrary-type) data
 - priority queues: finding/deleting the highest number in a set

 To prove the correctness of such programs, we need to reason
 about less-than comparisons (for example, on integers) and about
 "these two sets/sequences have the same contents".  In this
 chapter, we introduce some techniques for reasoning about:
 - less-than comparisons on natural numbers
 - permutations (rearrangements of lists)
 Then, in later chapters, we'll apply these proof techniques
 to reasoning about algorithms and data structures.
 *)

Require Export Coq.Bool.Bool.
Require Export Coq.Arith.Arith.
Require Export Coq.Arith.EqNat.
Require Export Coq.omega.Omega.
Require Export Coq.Lists.List.
Export ListNotations.
Require Export Permutation.

(* ################################################################# *)
(** * The less-than order on the natural numbers *)

(** These [Check] and [Locate] commands remind us about
  _Propositional_ and the _Boolean_ less-than operators
  in the Coq standard library. *)

Check Nat.lt.        (* : nat -> nat -> Prop *)
Check lt.             (* : nat -> nat -> Prop *)
Goal Nat.lt = lt. Proof. reflexivity. Qed. (* They are the same *)
Check Nat.ltb.       (* : nat -> nat -> bool *)
Locate "_ < _".  (* "x < y" := lt x y *)
Locate "<?".     (* x <? y  := Nat.ltb x y *)

(** We write [x < y] for the Proposition that [x] _is_ less than [y],
    and we write [x <? y] for the computable _test_ that returns
    [true] or [false] depending on whether [x<y].  The theorem that
    [lt] is related in this way to [ltb] is this one: *)

Check Nat.ltb_lt.
(* : forall n m : nat, (n <? m) = true <-> n < m *)

(** For some reason, the Coq library has [ <? ] and [ <=? ]
    notations, but is missing these three: *)

Notation  "a >=? b" := (Nat.leb b a)
                          (at level 70, only parsing) : nat_scope.
Notation  "a >? b"  := (Nat.ltb b a)
                       (at level 70, only parsing) : nat_scope.
Notation " a =? b"  := (beq_nat a b)
                       (at level 70) : nat_scope.

(* ================================================================= *)
(** ** Relating [Prop] to [bool] *)

(** The [reflect] relation connects a [Proposition] to a [Boolean]. *)

Print reflect.

(** That is, [reflect P b] means that [P<->True] if and only if [b=true].
     The way to use [reflect] is, for each of your operators, make a
     lemma like these next three:
*)

Lemma beq_reflect : forall x y, reflect (x = y) (x =? y).
Proof.
  intros x y.
  apply iff_reflect. symmetry.  apply beq_nat_true_iff.
Qed.

Lemma blt_reflect : forall x y, reflect (x < y) (x <? y).
Proof.
  intros x y.
  apply iff_reflect. symmetry. apply Nat.ltb_lt.
Qed.

Lemma ble_reflect : forall x y, reflect (x <= y) (x <=? y).
Proof.
  intros x y.
  apply iff_reflect. symmetry. apply Nat.leb_le.
Qed.

(** Here's an example of how you could use these lemmas.
    Suppose you have this simple program, [(if a <? 5 then a else 2)],
    and you want to prove that it evaluates to a number smaller than 6.
    You can use [blt_reflect] "by hand": *)

Example reflect_example1: forall a, (if a<?5 then a else 2) < 6.
Proof.
  intros.
  destruct (blt_reflect a 5) as [H|H].
  * (* Notice that [H] above the line has a [Prop]ositional
       fact _related_ to [a<?5]*)
     omega.  (* More explanation of [omega] later in this chapter. *)
  * (* Notice that [H] above the line has a a _different_
       [Prop]ositional fact. *)
     apply not_lt in H.  (* This step is not necessary,
          it just makes the hypothesis [H] look pretty *)
     omega.
Qed.

(** But there's another way to use [blt_reflect], etc: read on. *)

(* ================================================================= *)
(** ** Some advanced tactical hacking. *)
(** You may skip ahead to "Inversion/clear/subst".
     Right here, we build some machinery that you'll want to
     _use_, but you won't need to know how to _build_ it.

    Let's put several of these [reflect] lemmas into a Hint database,
    called [bdestruct] because we'll use it in our boolean-destruction
    tactic: *)

Hint Resolve blt_reflect ble_reflect beq_reflect : bdestruct.

(** Our high-tech _boolean destruction_ tactic: *)

Ltac bdestruct X :=
  let H := fresh in let e := fresh "e" in
   evar (e: Prop);
   assert (H: reflect e X); subst e;
    [eauto with bdestruct
    | destruct H as [H|H];
       [ | try first [apply not_lt in H | apply not_le in H]]].

(** Here's a brief example of how to use [bdestruct].  There
     are more examples later. *)

Example reflect_example2: forall a, (if a<?5 then a else 2) < 6.
Proof.
  intros.
  bdestruct (a<?5).  (* instead of: [destruct (blt_reflect a 5) as [H|H]]. *)
  * (* Notice that [H] above the line has a [Prop]ositional
       fact _related_ to [a<?5]*)
     omega.  (* More explanation of [omega] later in this chapter. *)
  * (* Notice that [H] above the line has a a _different_
       [Prop]ositional fact. We don't need to apply [not_lt],
       as [bdestruct] has already done it. *)
     omega.
Qed.

(* ================================================================= *)
(** ** Inversion/clear/subst *)
(** Coq's [inversion H] tactic is so good at extracting information
    from the hypothesis [H] that [H] becomes completely redundant,
    and one might as well [clear] it from the goal.  Then, since the
    [inversion] typically creates some equality facts, why not then
    [subst] ?   This motivates the following useful tactic, [inv]:  *)

Ltac inv H := inversion H; clear H; subst.

(* ================================================================= *)
(** ** Linear integer inequalities *)

(** In our proofs about searching and sorting algorithms, we
    sometimes have to reason about the consequences of
    less-than and greater-than.  Here's a contrived example. *)

Module Exploration1.

Theorem omega_example1:
 forall i j k,
    i < j ->
    ~ (k - 3 <= j) ->
   k > i.
Proof.
  intros.

(** Now, there's a hard way to prove this, and an easy way.
    Here's the hard way. *)

  (* try to remember the name of the lemma about negation and [<=] *)
  SearchAbout (~ _ <= _ -> _).
  apply not_le in H0.
  (* try to remember the name of the transitivity lemma about [>] *)
  SearchAbout (_ > _ -> _ > _ -> _ > _).
  apply gt_trans with j.
  apply gt_trans with (k-3).
  (* _OBVIOUSLY_, [k] is greater than [k-3].  But _OOPS_,
     this is not actually true, because we are talking about
     natural numbers with "bogus subtraction." *)
Abort.

Theorem bogus_subtraction: ~ (forall k:nat, k > k - 3).
Proof.
  (* [intro] introduces exactly one thing, like [intros ?] *)
  intro.
  (* [specialize] applies a hypothesis to an argument *)
  specialize (H O).
  simpl in H. inversion H.
Qed.

(** With bogus subtraction, this omega_example1 theorem even True?
    Yes it is; let's try again, the hard way, to find the proof. *)

Theorem omega_example1:
 forall i j k,
    i < j ->
    ~ (k - 3 <= j) ->
   k > i.
Proof. (* try again! *)
  intros.
  apply not_le in H0.
  unfold gt in H0.
  unfold gt.
  (* try to remember the name ... *)
  SearchAbout (_ < _ -> _ <= _ -> _ < _).
  apply lt_le_trans with j.
  apply H.
  apply le_trans with (k-3).
  SearchAbout (_ < _ -> _ <= _).
  apply lt_le_weak.
  auto.
  apply le_minus.
Qed.  (* Oof!  That was exhausting and tedious.  *)

(** And here's the easy way. *)

Theorem omega_example2:
 forall i j k,
    i < j ->
    ~ (k - 3 <= j) ->
   k > i.
Proof.
  intros.
  omega.
Qed.

(** Here we have used the [omega] tactic, made available by importing
    [Coq.omega.Omega] as we have done above.  Omega is an algorithm
    for integer linear programming, invented in 1991 by William Pugh.
    Because ILP is NP-complete, we might expect that this algorithm is
    exponential-time in the worst case, and indeed that's true: if you
    have [N] equations, it could take [2^N] time.  But in the typical
    cases that result from reasoning about programs, omega is much
    faster than that.  Coq's [omega] tactic is an implementation of
    this algorithm that generates a machine-checkable Coq proof.  It
    "understands" the types Z and nat, and these operators: [<] [=] [>] [<=]
    [>=] [+] [-] [~], as well as multiplication by small integer
    literals (such as 0,1,2,3...) and some uses of [\/] and [/\].

    Omega does _not_ understand other operators.  It treats things
    like [a*b] and [f x y] as if they were variables.  That is, it can
    prove [f x y > a*b -> f x y + 3 >= a*b], in the same way it would
    prove [u > v -> u+3 >= v].

    Now let's consider a silly little program: swap the first two
    elements of a list, if they are out of order. *)

Definition maybe_swap (al: list nat) : list nat :=
  match al with
  | a :: b :: ar => if a >? b then b::a::ar else a::b::ar
  | _ => al
  end.

Example maybe_swap_123:
  maybe_swap [1; 2; 3] = [1; 2; 3].
Proof. reflexivity. Qed.

Example maybe_swap_321:
  maybe_swap [3; 2; 1] = [2; 3; 1].
Proof. reflexivity. Qed.

(** In this program, we wrote [a>?b] instead of [a>b].  Why is that? *)

Check (1>2).  (* : Prop *)
Check (1>?2). (* : bool *)

(** We cannot compute with elements of [Prop]: we need some kind of
    constructible (and pattern-matchable) value.  For that we use
    [bool]. *)

Locate ">?".  (* a >? b :=  ltb b a *)

(** The name [ltb] stands for "less-than boolean." *)

Print Nat.ltb.
(* =  fun n m : nat => S n <=? m : nat -> nat -> bool  *)
Locate ">=?".

(** Instead of defining an operator [Nat.geb], the standard library just
    defines the notation for greater-or-equal-boolean as a
    less-or-equal-boolean with the arguments swapped. *)

Locate leb.
Print leb.
Print Nat.leb.  (* The computation to compare natural numbers. *)

(** Here's a theorem: [maybe_swap] is idempotent -- that is, applying it
    twice gives the same result as applying it once. *)

Theorem maybe_swap_idempotent:
  forall al, maybe_swap (maybe_swap al) = maybe_swap al.
Proof.
  intros.
  destruct al as [ | a al].
  simpl.
  reflexivity.
  destruct al as [ | b al].
  simpl.
  reflexivity.
  simpl.

  (** What do we do here?   We must proceed by case analysis on
     whether a>b. *)

  destruct (b <? a) eqn:H.
  simpl.
  destruct (a <? b) eqn:H0.

  (** Now what?  Look at the hypotheses [H: b<a] and [H0: a<b]
      above the line. They can't both be true.  In fact, [omega]
      "knows" how to prove that kind of thing.  Let's try it: *)

  try omega.

  (** [omega] didn't work, because it operates on comparisons in [Prop],
      such as [a>b]; not upon comparisons yielding bool, such as [a>?b].
      We need to convert these comparisons to [Prop], so that we can use
      [omega].

      Actually, we don't "need" to.  Instead, we could reason directly
      about these operations in [bool].  But that would be even more
      tedious than the [omega_example1] proof.  Therefore: let's set up
      some machinery so that we can use [omega] on boolean tests. *)

Abort.

(** Let's try again, a new way: *)

Theorem maybe_swap_idempotent:
  forall al, maybe_swap (maybe_swap al) = maybe_swap al.
Proof.
  intros.
  destruct al as [ | a al].
  simpl.
  reflexivity.
  destruct al as [ | b al].
  simpl.
  reflexivity.
  simpl.

  (** This is where we left off before. Now, watch: *)

  destruct (blt_reflect b a).   (* THIS LINE *)
  (* Notice that [b<a] is above the line as a Prop, not a bool.
     Now, comment out THIS LINE, and uncomment THAT LINE.  *)
  (* bdestruct (b <? a).    (* THAT LINE *) *)
  (* THAT LINE, with [bdestruct], does the same thing as THIS LINE. *)
* (* case b<a *)
  simpl.
  bdestruct (a <? b).
  omega.

  (** The [omega] tactic noticed that above the line we have an
      arithmetic contradiction.  Perhaps it seems wasteful to bring
      out the "big gun" to shoot this flea, but really, it's easier
      than remembering the names of all those lemmas about
      arithmetic! *)

  reflexivity.
* (* case a >= b *)
  simpl.
  bdestruct (b <? a).
  omega.
  reflexivity.
Qed.

(** Moral of this story: When proving things about a program that uses
    boolean comparisons [(a <? b)], use [bdestruct].  Then use
    [omega].  Let's review that proof without all the comments. *)

Theorem maybe_swap_idempotent':
  forall al, maybe_swap (maybe_swap al) = maybe_swap al.
Proof.
  intros.
  destruct al as [ | a al].
  simpl.
  reflexivity.
  destruct al as [ | b al].
  simpl.
  reflexivity.
  simpl.
  bdestruct (b <? a).
*
  simpl.
  bdestruct (a <? b).
  omega.
  reflexivity.
*
  simpl.
  bdestruct (b <? a).
  omega.
  reflexivity.
Qed.

(* ################################################################# *)
(** * Permutations *)

(** Another useful fact about [maybe_swap] is that it doesn't add or
    remove elements from the list: it only reorders them.  We can say
    that the output list is a _permutation_ of the input.  The Coq
    [Permutation] library has an inductive definition of permutations,
    along with some lemmas about them. *)

Locate Permutation. (* Inductive Coq.Sorting.Permutation.Permutation *)
Check Permutation. (*  : forall {A : Type}, list A -> list A -> Prop *)

(** We say "list [al] is a permutation of list [bl]",
     written [Permutation al bl], if the elements of [al] can be
     reordered (without insertions or deletions) to get the list [bl]. *)

Print Permutation.
(*
 Inductive Permutation {A : Type} : list A -> list A -> Prop :=
    perm_nil : Permutation [] []
  | perm_skip : forall (x : A) (l l' : list A),
                Permutation l l' ->
                Permutation (x :: l) (x :: l')
  | perm_swap : forall (x y : A) (l : list A),
                Permutation (y :: x :: l) (x :: y :: l)
  | perm_trans : forall l l' l'' : list A,
                 Permutation l l' ->
                 Permutation l' l'' ->
                 Permutation l l''.
*)

(** You might wonder, "is that really the right definition?"  And
    indeed, it's important that we get a right definition, because
    [Permutation] is going to be used in the specification of
    correctness of our searching and sorting algorithms.  If we have
    the wrong specification, then all our proofs of "correctness" will
    be useless.

    It's not obvious that this is indeed the right specification of
    permutations. (It happens to be true, but it's not obvious!)  In
    order to gain confidence that we have the right specification, we
    should use this specification to prove some properties that we
    think permutations ought to have. *)

(** **** Exercise: 2 stars (Permutation_properties)  *)
(** Think of some properties of the [Permutation] relation and write
    them down informally in English, or a mix of Coq and English.
    Here are four to get you started:
     - 1. If [Permutation al bl], then [length al = length bl].
     - 2. If [Permutation al bl], then [Permutation bl al].
     - 3. [[1;1]] is NOT a permutation of [[1;2]].
     - 4. [[1;2;3;4]] IS a permutation of [[3;4;2;1]].

   YOUR ASSIGNMENT: Add three more properties. Write them here: *)

(** Now, let's examine all the theorems in the Coq library about
    permutations: *)

SearchAbout Permutation.  (* Browse through the results of this query! *)

(** Which of the properties that you wrote down above have already
    been proved as theorems by the Coq library developers?  Answer
    here:

*)
(** [] *)

(** Let's use the permutation rules in the library to prove the
    following theorem. *)

Example butterfly: forall b u t e r f l y : nat,
  Permutation ([b;u;t;t;e;r]++[f;l;y]) ([f;l;u;t;t;e;r]++[b;y]).
Proof.
 intros.
 (* Just to illustrate a method, let's group [u;t;t;e;r] together: *)
 change [b;u;t;t;e;r] with ([b]++[u;t;t;e;r]).
 change [f;l;u;t;t;e;r] with ([f;l]++[u;t;t;e;r]).
 remember [u;t;t;e;r] as utter.
 clear Hequtter.
 (* Next, let's cancel [utter] from both sides.  In order to do that,
    we need to bring [utter] to the beginning of each list. *)
Check app_assoc.
  rewrite <- app_assoc.
  rewrite <- app_assoc.
Check perm_trans.
  apply perm_trans with (utter ++ [f;l;y] ++ [b]).
  rewrite (app_assoc utter [f;l;y]).
Check Permutation_app_comm.
  apply Permutation_app_comm.
 eapply perm_trans.
 2: apply Permutation_app_comm.
  rewrite <- app_assoc.
Search (Permutation (_++_) (_++_)).
 apply Permutation_app_head.
 (* Now that [utter] is utterly removed from the goal, let's cancel [f;l]. *)
 eapply perm_trans.
 2: apply Permutation_app_comm.
 simpl.
Check perm_skip.
 apply perm_skip.
 apply perm_skip.
Search (Permutation (_::_) (_::_)).
 apply perm_swap.
Qed.

(** That example illustrates a general method for proving
  permutations involving cons [::] and append [++].
  You identify some portion appearing in both sides;
  you bring that portion to the front on each side using
  lemmas such as [Permutation_app_comm] and [perm_swap],
  with generous use of [perm_trans].  Then, you use
  [perm_skip] to cancel a single element, or [Permutation_app_head]
  to cancel an append-chunk. *)

(** **** Exercise: 3 stars (permut_example)  *)
(** Use the permutation rules in the library (see the [SearchAbout],
    above) to prove the following theorem.  These [Check] commands
   are a hint about what lemmas you'll need. *)

Check perm_skip.
Check Permutation_refl.
Check Permutation_app_comm.
Check app_assoc.

Example permut_example: forall (a b: list nat),
  Permutation (5::6::a++b) ((5::b)++(6::a++[])).
Proof.
 (* After you cancel the [5], then bring the [6] to the front... *)
(* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 1 star (not_a_permutation)  *)
(** Prove that [[1;1]] is not a permutation of [[1;2]].
    Hints are given as [Check] commands. *)

Check Permutation_cons_inv.
Check Permutation_length_1_inv.

Example not_a_permutation:
  ~ Permutation [1;1] [1;2].
Proof.
(* FILL IN HERE *) Admitted.
(** [] *)

(** Back to [maybe_swap].  We prove that it doesn't lose or gain
   any elements, only reorders them. *)

Theorem maybe_swap_perm: forall al,
  Permutation al (maybe_swap al).
Proof.
  (* WORKED IN CLASS *)
  intros.
  destruct al as [ | a al].
  simpl. apply Permutation_refl.
  destruct al as [ | b al].
  simpl. apply Permutation_refl.
  simpl.
  bdestruct (a>?b).
  apply perm_swap.
  apply Permutation_refl.
Qed.

(** Now let us specify functional correctness of [maybe_swap]:
    it rearranges the elements in such a way that the first is
    less-or-equal than the second. *)

Definition first_le_second (al: list nat) : Prop :=
  match al with
  | a::b::_ => a <= b
  | _ => True
  end.

Theorem maybe_swap_correct: forall al,
    Permutation al (maybe_swap al)
    /\ first_le_second (maybe_swap al).
Proof.
  intros.
  split.
  apply maybe_swap_perm.
  (* WORKED IN CLASS *)
  destruct al as [ | a al].
  simpl. auto.
  destruct al as [ | b al].
  simpl. auto.
  simpl.
  bdestruct (b <? a).
  simpl.
  omega.
  simpl.
  omega.
Qed.

End Exploration1.

(* ################################################################# *)
(** * Summary: Comparisons and permutations *)

(** To prove correctness of algorithms for sorting and searching,
  we'll reason about comparisons and permutations using the tools
  developed in this chapter.  The [maybe_swap] program is a tiny
  little example of a sorting program.  The proof style in
  [maybe_swap_correct] will be applied (at a larger scale) in
  the next few chapters. *)

(** **** Exercise: 2 stars (Forall_perm)  *)
(** To close, a useful utility lemma.  Prove this by induction;
  but is it induction on [al], or on [bl], or on [Permutation al bl],
  or on [Forall f al]  ? *)

Theorem Forall_perm: forall {A} (f: A -> Prop) al bl,
  Permutation al bl ->
  Forall f al -> Forall f bl.
Proof.
(* FILL IN HERE *) Admitted.
(** [] *)

(** $Date: 2017-05-18 12:44:19 -0400 (Thu, 18 May 2017) $ *)


Require Import ZArith.

Lemma eqb_refl :
  forall (n : nat), (n =? n) = true.
Proof.
  induction n.
  simpl.
  reflexivity.
  simpl.
  assumption.
Qed.

Lemma eqb_symm :
  forall (m n : nat),
  (n =? m) = (m =? n).
Proof.
  intro m.
  induction m.
  induction n.
  simpl.
  reflexivity.
  reflexivity.
  induction n.
  reflexivity.
  apply IHm with (n := n).
Qed.

Lemma eqb_true_iff (m n : nat) :
  (m =? n) = true <-> m = n.
Proof.
  split.
  revert n.
  induction m.
  induction n.
  intro.
  reflexivity.
  intro.
  discriminate H.
  induction n.
  intro.
  discriminate H.
  intro.
  apply f_equal with (f := S).
  apply IHm with (n := n).
  assumption.
  intro.
  rewrite H.
  apply eqb_refl.
Qed.

Lemma leb_refl :
  forall (n : nat), (n <=? n) = true.
Proof.
  induction n.
  reflexivity.
  assumption.
Qed.

Lemma ltb_or_leb :
  forall (m n : nat),
  (n <? m) = true \/ (m <=? n) = true.
Proof.
  induction m.
  induction n.
  right.
  reflexivity.
  right.
  reflexivity.
  induction n.
  left.
  reflexivity.
  destruct IHm with (n := n).
  left.
  assumption.
  right.
  assumption.
Qed.

Lemma ltb_compare_dec (m n : nat) :
  (m <? n) = true \/ (n <? m) = true \/ m = n.
Proof.
  revert n.
  induction m.
  induction n.
  right.
  right.
  reflexivity.
  left.
  reflexivity.
  induction n.
  right.
  left.
  reflexivity.
  destruct IHm with (n := n).
  left.
  assumption.
  destruct H.
  right.
  left.
  assumption.
  right.
  right.
  apply f_equal with (f := S).
  assumption.
Qed.

Lemma nat_compare_ltb (m n : nat) :
  (m <? n) = true <-> Nat.compare m n = Lt.
Proof.
  revert n.
  induction m.
  induction n.
  split ; intro ; discriminate H.
  split ; intro ; reflexivity.
  induction n.
  split ; intro ; discriminate H.
  apply IHm.
Qed.

Lemma nat_compare_gtb (m n : nat) :
  (n <? m) = true <-> Nat.compare m n = Gt.
Proof.
  revert n.
  induction m.
  induction n ; split ; intro ; discriminate H.
  induction n.
  split ; intro ; reflexivity.
  apply IHm.
Qed.

Lemma nat_compare_eq (n : nat) :
  Nat.compare n n = Eq.
Proof.
  induction n.
  reflexivity.
  apply IHn.
Qed.

Lemma leb_trans :
  forall (m n p: nat),
    (m <=? n) = true -> (n <=? p) = true -> (m <=? p) = true.
Proof.
  induction m.
  simpl.
  reflexivity.

  destruct n.
  simpl.
  intros.
  discriminate H.

  destruct p.
  simpl.
  intros.
  discriminate H0.
  simpl.
  apply IHm.
Qed.

Lemma leb_antisymm :
  forall (m n : nat),
  (m <=? n) = true ->
  (n <=? m) = true ->
  m = n.
Proof.
  induction m.
  induction n.
  intros.
  reflexivity.
  intro.
  simpl.
  intro.
  discriminate H0.

  induction n.
  simpl.
  intro.
  discriminate H.

  simpl.
  intros.
  apply f_equal with (f := S).
  apply IHm with (n := n).
  assumption.
  assumption.
Qed.

Lemma leb_succ :
  forall (n : nat),
    (n <=? (S n)) = true.
Proof.
  induction n.
  simpl.
  reflexivity.
  simpl.
  assumption.
Qed.

Lemma ltb_is_neqb :
  forall (m n : nat),
  (m <? n) = true ->
  (m =? n) = false.
Proof.
  induction m.
  induction n.
  unfold Nat.ltb.
  simpl.
  intro.
  discriminate H.
  intro.
  simpl.
  reflexivity.

  induction n.
  intro.
  simpl.
  reflexivity.
  unfold Nat.ltb.
  simpl.
  intro.
  apply IHm with (n := n).
  assumption.
Qed.

Lemma ltb_is_neqb2 :
  forall (m n : nat),
  (m <? n) = true ->
  (n =? m) = false.
Proof.
  induction m.
  induction n.
  unfold Nat.ltb.
  simpl.
  intro.
  discriminate H.
  intro.
  simpl.
  reflexivity.

  induction n.
  intro.
  simpl.
  reflexivity.
  unfold Nat.ltb.
  simpl.
  intro.
  apply IHm with (n := n).
  assumption.
Qed.

Lemma ltb_antisymm :
  forall (m n : nat),
  (m <? n) = true ->
  (n <? m) = false.
Proof.
  induction m.
  induction n.
  intro.
  unfold Nat.ltb.
  simpl.
  reflexivity.
  intro.
  unfold Nat.ltb.
  simpl.
  reflexivity.

  induction n.
  unfold Nat.ltb.
  simpl.
  intro.
  discriminate H.
  unfold Nat.ltb.
  simpl.
  intro.
  apply IHm with (n := n).
  assumption.
Qed.

Lemma ltb_leb :
  forall (m n : nat),
  (n <? m) = false <->
  (m <=? n) = true.
Proof.
  split.
  unfold Nat.ltb.
  revert m.
  induction n.
  induction m.
  intro.
  simpl.
  reflexivity.
  simpl.
  intro.
  discriminate H.

  induction m.
  intro.
  simpl.
  reflexivity.
  intro.
  simpl.
  apply IHn with (m := m).
  simpl in H.
  assumption.

  revert m.
  induction n.
  induction m.
  intro.
  simpl.
  reflexivity.
  simpl.
  intro.
  discriminate H.

  induction m.
  intro.
  simpl.
  reflexivity.
  intro.
  simpl.
  apply IHn with (m := m).
  simpl in H.
  assumption.
Qed.

Lemma leb_ltb :
  forall (m n : nat),
  (n <=? m) = false <->
  (m <? n) = true.
Proof.
  split.
  unfold Nat.ltb.
  revert m.
  induction n.
  induction m.
  discriminate.
  discriminate.

  induction m.
  intro.
  simpl.
  reflexivity.
  intro.
  simpl.
  apply IHn with (m := m).
  simpl in H.
  assumption.

  revert m.
  induction n.
  induction m.
  discriminate.
  discriminate.
  induction m.
  intro.
  simpl.
  reflexivity.
  intro.
  simpl.
  apply IHn with (m := m).
  simpl in H.
  assumption.
Qed.

Lemma leb_max_l (m n : nat) :
  m <=? Nat.max m n = true.
Proof.
  revert n.
  induction m.
  induction n.
  reflexivity.
  reflexivity.
  induction n.
  unfold Nat.max.
  apply leb_refl.
  apply IHm with (n := n).
Qed.

Lemma leb_max_r (m n : nat) :
  n <=? Nat.max m n = true.
Proof.
  revert m.
  induction n.
  induction m.
  reflexivity.
  reflexivity.
  induction m.
  apply leb_refl.
  apply IHn with (m := m).
Qed.

Lemma leb_plus_simpl (m n c : nat) :
  (m <=? n) = true -> (m + c <=? n + c) = true.
Proof.
  induction c.
  intro.
  rewrite Nat.add_0_r.
  rewrite Nat.add_0_r.
  assumption.
  rewrite Nat.add_comm with (m := S c) (n := m).
  rewrite Nat.add_comm with (m := S c) (n := n).
  intro.
  simpl Nat.add.
  simpl Nat.leb.
  rewrite Nat.add_comm with (m := m) (n := c).
  rewrite Nat.add_comm with (m := n) (n := c).
  apply IHc.
  assumption.
Qed.

Lemma leb_plus (m1 m2 n1 n2 : nat) :
  (m1 <=? m2) = true -> (n1 <=? n2) = true -> m1 + n1 <=? m2 + n2 = true.
Proof.
  intros.
  apply leb_trans with (n := m1 + n2).
  rewrite Nat.add_comm with (m := n1) (n := m1).
  rewrite Nat.add_comm with (m := n2) (n := m1).
  apply leb_plus_simpl.
  assumption.
  apply leb_plus_simpl.
  assumption.
Qed.

Lemma rec_init :
  forall (P : nat -> Prop),
  (forall (n : nat), P n -> P (S n)) ->
  forall (m n : nat), (m <=? n) = true -> P m -> P n.
Proof.
  intros P H m n.
  revert P H n.

  induction m.
  intros.
  induction n.
  assumption.
  apply H.
  apply IHn.
  assumption.

  induction n.
  intro.
  discriminate H0.

  intros.
  apply IHm with (P := fun i => P (S i)).
  intro.
  apply H with (n := S n0).
  simpl in H0.
  assumption.
  assumption.
Qed.

Lemma z_integrity (m n : Z) :
  (Z.mul m n = Z.zero) <-> (m = Z.zero) \/ (n = Z.zero).
Proof.
  split.
  revert n.
  induction m.
  intros.
  left.
  reflexivity.
  intros.
  right.
  induction n.
  reflexivity.
  simpl Z.mul in H.
  discriminate H.
  simpl Z.mul in H.
  discriminate H.

  intros.
  induction n.
  right.
  reflexivity.
  simpl Z.mul in H.
  discriminate H.
  simpl Z.mul in H.
  discriminate H.

  intro.
  destruct H.
  rewrite H.
  simpl Z.mul.
  reflexivity.
  rewrite H.
  induction m.
  reflexivity.
  reflexivity.
  reflexivity.
Qed.

Import Z.

Lemma excluded_middle_nat (m n : nat) :
  m = n \/ m <> n.
Proof.
  revert n.
  induction m.
  induction n.
  left.
  reflexivity.
  right.
  discriminate.
  induction n.
  right.
  discriminate.
  destruct IHm with (n := n).
  left.
  apply f_equal with (f := S).
  assumption.
  right.
  injection.
  assumption.
Qed.


From Hammer Require Import Hammer.

Require Import NZAxioms NZBase NZAdd.

Module Type NZMulProp (Import NZ : NZAxiomsSig')(Import NZBase : NZBaseProp NZ).
Include NZAddProp NZ NZBase.

Theorem mul_0_r : forall n, n * 0 == 0.
Proof. hammer_hook "NZMul" "NZMul.NZMulProp.mul_0_r".
nzinduct n; intros; now nzsimpl.
Qed.

Theorem mul_succ_r : forall n m, n * (S m) == n * m + n.
Proof. hammer_hook "NZMul" "NZMul.NZMulProp.mul_succ_r".
intros n m; nzinduct n. now nzsimpl.
intro n. nzsimpl. rewrite succ_inj_wd, <- add_assoc, (add_comm m n), add_assoc.
now rewrite add_cancel_r.
Qed.

Hint Rewrite mul_0_r mul_succ_r : nz.

Theorem mul_comm : forall n m, n * m == m * n.
Proof. hammer_hook "NZMul" "NZMul.NZMulProp.mul_comm".
intros n m; nzinduct n. now nzsimpl.
intro. nzsimpl. now rewrite add_cancel_r.
Qed.

Theorem mul_add_distr_r : forall n m p, (n + m) * p == n * p + m * p.
Proof. hammer_hook "NZMul" "NZMul.NZMulProp.mul_add_distr_r".
intros n m p; nzinduct n. now nzsimpl.
intro n. nzsimpl. rewrite <- add_assoc, (add_comm p (m*p)), add_assoc.
now rewrite add_cancel_r.
Qed.

Theorem mul_add_distr_l : forall n m p, n * (m + p) == n * m + n * p.
Proof. hammer_hook "NZMul" "NZMul.NZMulProp.mul_add_distr_l".
intros n m p.
rewrite (mul_comm n (m + p)), (mul_comm n m), (mul_comm n p).
apply mul_add_distr_r.
Qed.

Theorem mul_assoc : forall n m p, n * (m * p) == (n * m) * p.
Proof. hammer_hook "NZMul" "NZMul.NZMulProp.mul_assoc".
intros n m p; nzinduct n. now nzsimpl.
intro n. nzsimpl. rewrite mul_add_distr_r.
now rewrite add_cancel_r.
Qed.

Theorem mul_1_l : forall n, 1 * n == n.
Proof. hammer_hook "NZMul" "NZMul.NZMulProp.mul_1_l".
intro n. now nzsimpl'.
Qed.

Theorem mul_1_r : forall n, n * 1 == n.
Proof. hammer_hook "NZMul" "NZMul.NZMulProp.mul_1_r".
intro n. now nzsimpl'.
Qed.

Hint Rewrite mul_1_l mul_1_r : nz.

Theorem mul_shuffle0 : forall n m p, n*m*p == n*p*m.
Proof. hammer_hook "NZMul" "NZMul.NZMulProp.mul_shuffle0".
intros n m p. now rewrite <- 2 mul_assoc, (mul_comm m).
Qed.

Theorem mul_shuffle1 : forall n m p q, (n * m) * (p * q) == (n * p) * (m * q).
Proof. hammer_hook "NZMul" "NZMul.NZMulProp.mul_shuffle1".
intros n m p q. now rewrite 2 mul_assoc, (mul_shuffle0 n).
Qed.

Theorem mul_shuffle2 : forall n m p q, (n * m) * (p * q) == (n * q) * (m * p).
Proof. hammer_hook "NZMul" "NZMul.NZMulProp.mul_shuffle2".
intros n m p q. rewrite (mul_comm p). apply mul_shuffle1.
Qed.

Theorem mul_shuffle3 : forall n m p, n * (m * p) == m * (n * p).
Proof. hammer_hook "NZMul" "NZMul.NZMulProp.mul_shuffle3".
intros n m p. now rewrite mul_assoc, (mul_comm n), mul_assoc.
Qed.

End NZMulProp.


(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Unset Positivity Checking.
Unset Guard Checking.

Inductive nat : Set :=
| O : nat
| S : nat -> nat.

Inductive natural : Set :=
| Zero : natural
| Succ : natural -> natural.

Fixpoint plus (plus_arg0 : natural) (plus_arg1 : natural) {struct plus_arg0}
  : natural :=
  match plus_arg0 with
  | Zero => plus_arg1
  | Succ n => Succ (plus n plus_arg1)
  end.

Fixpoint mult (mult_arg0 : natural) (mult_arg1 : natural) {struct mult_arg0}
  : natural :=
  match mult_arg0 with
  | Zero => Zero
  | Succ n => plus (mult n mult_arg1) mult_arg1
  end.

Definition synth (lf1 : natural) (lf2 : natural) : natural :=
  plus Zero (Succ lf2).


Require Import Relations.
Section leibniz.
 Variable A : Set.

 Set Implicit Arguments.

 Definition leibniz (a b:A) : Prop := forall P:A -> Prop, P a -> P b.

 Theorem leibniz_sym : symmetric A leibniz.
 Proof.
  unfold symmetric, leibniz; intros a b H Q.
  apply H; trivial.
 Qed.

 Theorem leibniz_refl : reflexive A leibniz.
 Proof.
  unfold reflexive, leibniz; auto.
 Qed.

 Theorem leibniz_trans : transitive A leibniz.
 Proof.
  unfold transitive.
  intros x y z Hxy Hyz; unfold leibniz; intros.
  apply Hyz.
  apply Hxy; assumption.
 Qed.

 Hint Resolve leibniz_trans leibniz_sym leibniz_refl: sets.

 Theorem leibniz_equiv : equiv A leibniz.
 Proof.
  unfold equiv; auto with sets.
 Qed.

 Theorem leibniz_least :
  forall R:relation A, reflexive A R -> inclusion A leibniz R.
 Proof.
  unfold inclusion, leibniz; intros R H x y H0.
  apply H0.
  apply H.
 Qed.

 Theorem leibniz_eq : forall a b:A, leibniz a b -> a = b.
 Proof.
  intros.
  apply H.
  trivial.
 Qed.

 Theorem eq_leibniz : forall a b:A, a = b -> leibniz a b.
 Proof.
  intros a b e; rewrite e; unfold leibniz; auto.
 Qed.

 Theorem leibniz_ind :
  forall (x:A) (P:A -> Prop), P x -> forall y:A, leibniz x y -> P y.
 Proof.
  intros.
  apply H0.
  assumption.
 Qed.

 Set Strict Implicit.
Unset Implicit Arguments.
End leibniz.


Require Import List.
Require Import Bool.

Inductive nat : Type :=
| Z : nat
| S : nat -> nat.

Fixpoint add_nat (m n : nat): nat :=
  match m with
  | Z => n
  | S m => S (add_nat m n)
  end.

Lemma add_1 : forall m n : nat, S (add_nat n m) = add_nat n (S m).
Proof.
  intros.
  induction n.
  simpl.
  reflexivity.
  simpl.
  rewrite -> IHn.
  simpl.
  auto.
Qed.

Theorem add_commutes : forall m n : nat, add_nat m n = add_nat n m.
Proof.
  intros.
  induction m.
  simpl.
  induction n.
  simpl.
  reflexivity.
  simpl.
  rewrite <- IHn.
  reflexivity.
  simpl.
  rewrite -> IHm.
  apply add_1.
Qed.

Theorem reflex: forall A : Prop, A -> A.
Proof.
  intros.
  assumption.
Qed.

Theorem and_commutes: forall A B: Prop, A /\ B -> B /\ A.
Proof.
  intros.
  elim H.
  split.
  assumption.
  assumption.
Qed.

Theorem and_intro: forall A B: Prop, A -> B -> A /\ B.
Proof.
  intros.
  split; auto.
Qed.

Lemma tt: forall a b: nat, add_nat a (S b) = S (add_nat a b).
Proof.
  intros a b.
  rewrite -> add_commutes.
  simpl.
  rewrite -> add_commutes.
  reflexivity.
Qed.

Theorem add_assoc_1 : forall a b c: nat, S (add_nat b (add_nat a c)) = S (add_nat a (add_nat b c)).
Proof.
  intros a b c.
  induction b.
  simpl.
  reflexivity.
  simpl.
  rewrite -> IHb.
  symmetry.
  assert ( H : add_nat a (S (add_nat b c)) = S (add_nat a (add_nat b c)) ).
  apply tt.
  rewrite -> H.
  reflexivity.
Qed.

Theorem add_assoc : forall a b c: nat,  add_nat (add_nat a b) c = add_nat a (add_nat b c).
Proof.
  intros a b c.
  symmetry.
  induction a.
  simpl.
  reflexivity.
  simpl.
  rewrite -> IHa.
  reflexivity.
Qed.

Theorem demorgan1 : forall A B : Prop, (~ A) \/ (~ B) -> ~ (A /\ B).
Proof.
  intuition eauto.
Qed.

Axiom axiom_of_choice: forall P: Prop, P \/ (~ P) <-> True.

Axiom aa: forall x: Type, forall P : Type -> Prop, (P x) \/ (~ (P x)) <-> True.

Theorem absorption: forall P Q: Prop, (P \/ (P /\ Q)) <-> P.
Proof.
  intros P Q.
  split.
  intros H.
  elim H.
  intros H0.
  assumption.
  intros H0.
  elim H0.
  intros H1 H2.
  assumption.
  intros H.
  left.
  assumption.
Qed.

(* Multiplication *)
Fixpoint mult (m n: nat) :=
  match m with
  | Z => Z
  | (S m) => add_nat n (mult m n)
  end.

Lemma lem_mul1: forall a b: nat, add_nat b (mult b a) = mult b (S a).
Proof.
  intros a b.
  simpl.
  induction b.
  simpl.
  reflexivity.
  simpl.
  rewrite <- IHb.
  apply add_assoc_1.
Qed.

Theorem mult_comm: forall a b: nat, mult a b = mult b a.
Proof.
  intros a b.
  induction a.
  simpl.
  induction b; simpl; auto.
  simpl.
  rewrite -> IHa.
  apply lem_mul1.
Qed.

Lemma tt1: forall m n : nat, mult m (S n) = add_nat m (mult n m).
Proof.
  intros m n.
  simpl.
  induction m; simpl; auto.
  assert (Z = mult n Z).
  rewrite <- mult_comm; simpl; auto.
  assumption.
  rewrite -> IHm.
  symmetry.
  rewrite -> mult_comm.
  simpl.
  rewrite <- mult_comm.
  apply add_assoc_1.
Qed.

Lemma tty: forall a b m n:nat, add_nat (add_nat a m) (add_nat b n)
                        = add_nat (add_nat a b) (add_nat m n).
Proof.
  intros a b m n.
  rewrite -> add_assoc.
  assert (H : (add_nat m (add_nat b n)) = (add_nat (add_nat b n) m)).
  rewrite -> add_commutes.
  reflexivity.
  rewrite -> H.
  clear H.
  assert (H : (add_nat (add_nat b n) m) = (add_nat b (add_nat n m))).
  rewrite -> add_assoc.
  reflexivity.
  rewrite -> H.
  clear H.
  rewrite <- add_assoc.
  assert (H : (add_nat n m) = (add_nat m n)).
  rewrite <- add_commutes.
  reflexivity.
  rewrite -> H.
  reflexivity.
Qed.

Theorem mul_assoc: forall a b c:nat, mult a (add_nat b c) = add_nat (mult a b) (mult a c).
Proof.
  intros a b c.
  induction a; simpl; auto.
  rewrite -> IHa.
  symmetry.
  rewrite <- tt1; rewrite <- mult_comm.
  rewrite <- add_commutes.
  rewrite <- tt1; rewrite <- mult_comm.
  simpl.
  rewrite <- add_commutes.
  apply tty.
Qed.

Theorem nat_cong: forall x y: nat, forall (f : nat -> nat), (x = y) -> (f x) = (f y).
Proof.
  intros x y f H.
  rewrite H.
  reflexivity.
Qed.

Fixpoint geq (x y : nat) : Prop :=
                  match x with
                  | Z => True
                  | S x => geq x y
                  end.

Theorem geq_trans: forall x y z: nat, geq x y -> geq y z -> geq x z.
Proof.
  intros x y z H H0.
  induction x; simpl; auto.
Qed.

Inductive exp : Type -> Type :=
| Const : forall T, T -> exp T
| Pair : forall T1 T2, exp T1 -> exp T2 -> exp (T1 * T2)
| Eq : forall T, exp T -> exp T -> exp bool.

Check 2+3.
Check (cons 2 nil).

Inductive List {A : Set}: Set :=
| n : List
| c : A -> List  -> List .

Check c (S Z) (n).

Section Vector.
Inductive Vec (A: Set) : nat -> Set :=
| VNil : Vec A Z
| VCons : forall n : nat, A -> Vec A n -> Vec A (S n).

Arguments VCons [A] [n].
Arguments VNil [A].

Check VCons 2 (VCons 1 VNil).
End Vector.

Inductive eqsat {A : Set} (f g : A -> A) : Type :=
  feqg : forall x : A, (f x = g x) -> eqsat f g.

Definition f (A B C : bool): bool :=
  (A && B) || ((B && C) && (B ||C)).

Definition g (A B C :bool) : bool :=
  B && (A ||C).

Lemma fgsat : forall a b c: bool, eqsat (f a b) (g a b).
Proof.
  intros a b c.
  refine (feqg (f a b) (g a b) c _).
  destruct a, b, c; simpl; auto.
Qed.