(**************************************************************)
(*   Copyright Dominique Larchey-Wendling [*]                 *)
(*                                                            *)
(*                             [*] Affiliation LORIA -- CNRS  *)
(**************************************************************)
(*      This file is distributed under the terms of the       *)
(*         CeCILL v2 FREE SOFTWARE LICENSE AGREEMENT          *)
(**************************************************************)

Require Import List Arith Max Omega Wellfounded Bool.

Require Import list_focus utils_tac utils_list utils_nat.

Set Implicit Arguments.

(** We show that unbounded decidable predicates are exactly
    the direct images of strictly increasing sequences nat -> nat

    Hence, this gives an easy construction of the sequence
    of all primes ...

*)

Section sinc_decidable.

  Variable (P : nat -> Prop)
           (f : nat -> nat)
           (Hf : forall n, f n < f (S n))
           (HP : forall n, P n <-> exists k, n = f k).

  Let f_mono x y : x <= y -> f x <= f y.
  Proof.
    induction 1 as [ | y H IH ]; auto.
    apply le_trans with (1 := IH), lt_le_weak, Hf.
  Qed.

  Let f_smono x y : x < y -> f x < f y.
  Proof.
    intros H; apply f_mono in H.
    apply lt_le_trans with (2 := H), Hf.
  Qed.

  Let f_ge_n n : n <= f n.
  Proof.
    induction n as [ | n IHn ]; try omega.
    apply le_trans with (2 := Hf _); omega.
  Qed.

  Let unbounded n : exists k, n <= k /\ P k.
  Proof. exists (f n); split; auto; rewrite HP; exists n; auto. Qed.

  Let decidable n : { P n } + { ~ P n }.
  Proof.
    destruct (@bounded_search (S n) (fun i => f i = n))
      as [ (i & H1 & H2) | H1 ].
    + intros i _; destruct (eq_nat_dec (f i) n); tauto.
    + left; rewrite HP; eauto.
    + right; rewrite HP; intros (k & Hk).
      symmetry in Hk; generalize Hk; apply H1.
      rewrite <- Hk; apply le_n_S; auto.
  Qed.

  Theorem sinc_decidable : (forall n, exists k, n <= k /\ P k)
                         * (forall n, { P n } + { ~ P n }).
  Proof. split; auto. Qed.

End sinc_decidable.

Section decidable_sinc.

  Variable (P    : nat -> Prop)
           (Punb : forall n, exists k, n <= k /\ P k)
           (Pdec : forall n, { P n } + { ~ P n }).

  Let next n : { k | P k /\ n <= k /\ forall x, P x -> x < n \/ k <= x }.
  Proof.
    destruct min_dec with (P := fun k => P k /\ n <= k)
      as (k & (H1 & H2) & H3).
    + intros i; destruct (Pdec i); destruct (le_lt_dec n i); try tauto; right; intro; omega.
    + destruct (Punb (S n)) as (k & H1 & H2).
      exists k; split; auto; omega.
    + exists k; repeat (split; auto).
      intros x Hx.
      destruct (le_lt_dec n x); try omega.
      right; apply H3; auto.
  Qed.

  Let f := fix f n := match n with
    | 0   => proj1_sig (next 0)
    | S n => proj1_sig (next (S (f n)))
  end.

  Let f_sinc n : f n < f (S n).
  Proof.
    simpl.
    destruct (next (S (f n))) as (?&?&?&?); auto.
  Qed.

  Let f_select x : { n | f n <= x < f (S n) } + { x < f 0 }.
  Proof.
    induction x as [ | x IHx ].
    + destruct (eq_nat_dec 0 (f 0)) as [ H | H ].
      * left; exists 0; rewrite H at 2 3; split; auto.
      * right; omega.
    + destruct IHx as [ (n & Hn) | Hx ].
      * destruct (eq_nat_dec (S x) (f (S n))) as [ H | H ].
        - left; exists (S n); rewrite H; split; auto.
        - left; exists n; omega.
      * destruct (eq_nat_dec (S x) (f 0)) as [ H | H ].
        - left; exists 0; rewrite H; split; auto.
        - right; omega.
  Qed.

  Let f_P n : P n <-> exists k, n = f k.
  Proof.
    split.
    + intros Hn.
      destruct (f_select n) as [ (k & Hk) | C ].
      * simpl in Hk.
        destruct (next (S (f k))) as (m & H1 & H2 & H3); simpl in Hk.
        apply H3 in Hn.
        destruct Hn as [ Hn | Hn ]; try omega.
        exists k; omega.
      * simpl in C.
        destruct (next 0) as (m & H1 & H2 & H3); simpl in C.
        apply H3 in Hn; omega.
    + intros (k & Hk); subst.
      induction k as [ | k IHk ]; simpl.
      * destruct (next 0) as (m & H1 & H2 & H3); simpl; auto.
      * destruct (next (S (f k))) as (m & H1 & H2 & H3); simpl; auto.
  Qed.

  Theorem decidable_sinc : { f | (forall n, f n < f (S n))
                              /\ (forall n, P n <-> exists k, n = f k) }.
  Proof. exists f; auto. Qed.

End decidable_sinc.

Check sinc_decidable.
Check decidable_sinc.


Require Import List Arith Lia.
Import ListNotations.
From Undecidability.HOU Require Import std.tactics std.lists.basics std.decidable.

(* nth *)
Notation nth := nth_error.
Section Nth.

  Variable (X Y: Type).

  Lemma nth_error_map_option n (f: X -> Y) (A: list X):
    nth_error (map f A) n = option_map f (nth_error A n).
  Proof.
    destruct (nth_error A n) eqn: H1.
    + eapply map_nth_error in H1. rewrite H1. reflexivity.
    + eapply nth_error_None in H1.
      eapply nth_error_None. now rewrite map_length.
  Qed.

  Lemma nth_error_lt_Some Z m (L: list Z):
    m < length L -> exists a, nth L m = Some a.
  Proof.
    intros H % nth_error_Some.
    destruct nth; intuition idtac. now (exists z).
  Qed.

  Lemma nth_error_Some_lt Z m a (L: list Z):
    nth L m = Some a -> m < length L.
  Proof.
    intros H; eapply nth_error_Some; rewrite H; discriminate.
  Qed.

End Nth.

(* nats *)
Section Nats.

  Fixpoint nats (n: nat) :=
    match n with
    | 0 => nil
    | S n => 0 :: map S (nats n)
    end.

  Lemma nats_lt: forall k i, i ∈ nats k -> i < k.
  Proof.
    induction k; cbn; intuition idtac. lia.
    eapply in_map_iff in H0. destruct H0; intuition idtac; subst.
    specialize (IHk x H1); lia.
  Qed.

  Lemma nth_nats m k:
    m < k -> nth (nats k) m = Some m.
  Proof.
    induction k in m |-*.
    - lia.
    - intros; destruct m; cbn in *; eauto.
      erewrite map_nth_error; eauto.
      eapply IHk; lia.
  Qed.

  Lemma lt_nats x k:
    x < k -> x ∈ nats k.
  Proof.
    now intros H % nth_nats % nth_error_In.
  Qed.

  Lemma incl_nats I k:
    I ⊆ nats k -> forall i, i ∈ I -> i < k.
  Proof.
    firstorder using nats_lt.
  Qed.

  Lemma nats_incl I k:
    (forall i, i ∈ I -> i < k) -> I ⊆ nats k.
  Proof.
    firstorder using lt_nats.
  Qed.

  Lemma length_nats k: length (nats k) = k.
  Proof.
    induction k; cbn; lsimpl; congruence.
  Qed.

End Nats.
#[export] Hint Rewrite length_nats : listdb.

(* tabulate *)
Section Tabulate.
  Implicit Type  X: Type.

  Fixpoint tab {X} (f: nat -> X) k  :=
    match k with
    | 0 => nil
    | S n => tab f n ++ [f n]
    end.

  Lemma tab_length X (f: nat -> X) k: length (tab f k) = k.
  Proof.
    induction k; cbn; lsimpl; cbn; lsimpl; lia.
  Qed.

  Lemma tab_map X Y (f: nat -> X) (g: X -> Y) k:
    map g (tab f k) = tab (fun x => g (f x)) k.
  Proof.
    induction k; cbn; eauto; lsimpl; now rewrite IHk.
  Qed.

  Lemma tab_S X (f: nat -> X) n:
    tab f (S n) = f 0 :: tab (fun k => f (S k)) n.
  Proof.
    induction n; cbn; eauto.
    cbn in *; now rewrite IHn.
  Qed.

  Lemma tab_plus X (f: nat -> X) n m:
    tab f (n + m) = tab f n ++ tab (fun k => f (n + k)) m.
  Proof.
    induction n in f |-*; eauto.
    cbn [plus]; now rewrite tab_S, IHn, tab_S.
  Qed.

  Lemma tab_map_nats X k (f: nat -> X): tab f k = map f (nats k).
  Proof.
    induction k in f |-*; eauto.
    cbn [nats map]; now rewrite tab_S, IHk, map_map.
  Qed.

  Lemma tab_id_nats k: tab id k = nats k.
  Proof.
    rewrite tab_map_nats; now lsimpl.
  Qed.

  Lemma tab_nth {X} n m (f: nat -> X):
    n < m -> nth (tab f m) n = Some (f n).
  Proof.
    induction 1; cbn.
    + rewrite nth_error_app2, tab_length, Nat.sub_diag; cbn; eauto.
      rewrite tab_length; eauto.
    + rewrite nth_error_app1; eauto.
      now rewrite tab_length.
  Qed.

  Lemma tab_ext {X} (f g: nat -> X) n: (forall x, f x = g x) -> tab f n = tab g n.
  Proof.
    rewrite !tab_map_nats. intros; now apply map_ext.
  Qed.

End Tabulate.
#[export] Hint Rewrite tab_length tab_id_nats : listdb.

(* Repeated *)
Section Repeated.
  Variable (X Y: Type).
  Implicit Types (x y: X) (n m: nat) (f: X -> Y).

  Lemma repeated_in x n y: y ∈ repeat x n -> x = y.
  Proof.
    induction n; cbn; firstorder.
  Qed.

  Lemma repeated_plus n m x:
    repeat x (n + m) = repeat x n ++ repeat x m.
  Proof.
    induction n; cbn; congruence.
  Qed.

  Lemma repeated_rev n x: rev (repeat x n) = repeat x n.
  Proof.
    induction n; cbn; eauto.
    rewrite IHn. change [x] with (repeat x 1).
    rewrite <-repeated_plus.
    rewrite Nat.add_comm. reflexivity.
  Qed.

  Lemma repeated_map n x f:
    map f (repeat x n) = repeat (f x) n.
  Proof.
    induction n; cbn; congruence.
  Qed.

  Lemma repeated_length n x: length (repeat x n) = n.
  Proof.
    induction n; cbn; congruence.
  Qed.

  Lemma repeated_equal n y A:
    (forall x, x ∈ A -> x = y) -> length A = n -> repeat y n = A.
  Proof.
    induction A in n |-*; destruct n; cbn; eauto; try discriminate.
    injection 2. rewrite IHA; eauto.
    intros. erewrite <-H; intuition easy.
  Qed.

  Lemma repeated_incl x n A:
    x ∈ A -> repeat x n ⊆ A.
  Proof.
    intros ? ? ? % repeated_in; subst; eauto.
  Qed.

  Lemma repeated_tab (x: X) n:
    repeat x n = tab (Basics.const x) n.
  Proof.
    induction n; eauto; cbn [tab].
    replace (S n) with (n + 1) by lia.
    rewrite repeated_plus; cbn.
    rewrite IHn; reflexivity.
  Qed.

  Lemma nth_error_repeated (x: X) n k :
    k < n -> nth (repeat x n) k = Some x.
  Proof.
    intros H.
    erewrite repeated_tab, tab_map_nats, map_nth_error; eauto.
    now eapply nth_nats.
  Qed.

  Lemma repeated_app_inv n x A B:
    repeat x n = A ++ B ->
    n = length A + length B /\
    A = repeat x (length A) /\
    B = repeat x (length B).
  Proof.
    induction n in A, B |-*.
    - cbn; destruct A, B; try discriminate. intuition easy.
    - destruct A; cbn; try discriminate.
      + destruct B; try discriminate.
        injection 1. intuition idtac. cbn; now rewrite <-H0, repeated_length.
        subst. cbn; now rewrite repeated_length.
      + injection 1; intros; edestruct IHn; eauto.
        intuition auto. f_equal; eauto.
  Qed.

End Repeated.

#[export] Hint Rewrite  repeated_length repeated_map repeated_plus repeated_rev: listdb.

(* select *)
Section Select.

  Context {X: Type}.

  Fixpoint select (A: list nat) (B: list X)  :=
    match A with
    | nil => nil
    | i :: A => match nth B i with
               | Some x => x :: select A B
               | None => select A B
               end
    end.

  Lemma select_nil I:
    select I nil = nil.
  Proof.
    induction I; cbn.
    - reflexivity.
    - destruct nth eqn: H; eauto.
      eapply nth_error_In in H; cbn in H; intuition easy.
  Qed.

  Lemma select_S I (x: X) A:
    select (map S I) (x :: A) = select I A.
  Proof.
    induction I.
    - reflexivity.
    - cbn. rewrite IHI. reflexivity.
  Qed.

  Lemma select_nats k A:
    select (nats k) A = firstn k A.
  Proof.
    induction k in A |-*.
    - reflexivity.
    - destruct A.
      + rewrite select_nil; reflexivity.
      + cbn. rewrite select_S, IHk. reflexivity.
  Qed.

  Lemma select_repeated n I x:
    I ⊆ nats n -> select I (repeat x n) = repeat x (length I).
  Proof.
    induction I; cbn; eauto; intros.
    rewrite IHI; eauto with listdb.
    edestruct (nth_error_lt_Some) as [y H']; try rewrite H'.
    eapply nats_lt; lsimpl; firstorder.
    now eapply nth_error_In, repeated_in in H'; subst.
  Qed.

  Lemma select_incl I A: select I A ⊆ A.
  Proof.
    induction I; cbn; intuition (try easy).
    destruct nth eqn: H1; intuition idtac.
    eapply nth_error_In in H1. intuition (auto with datatypes).
  Qed.

  Lemma incl_select A B: A ⊆ B -> exists I, I ⊆ nats (length B) /\ select I B = A.
  Proof.
    induction A.
     + exists nil. lauto.
     + intros; destruct IHA as [I []]; lauto. specialize (H a). mp H; lauto.
        eapply In_nth_error in H as [i].
        exists (i::I). cbn. rewrite H, H1. split; lauto.
        eapply nth_error_Some_lt, lt_nats in H; lauto.
  Qed.
End Select.

Lemma select_map X Y (f: X -> Y) I A:
  map f (select I A) = select I (map f A).
Proof.
  induction I in A |-*; cbn; eauto.
  rewrite nth_error_map_option.
  destruct nth; cbn; now rewrite IHI.
Qed.

(* find *)
Section Find.

  Context {X: Type}.
  Context {D: Dis X}.

  Fixpoint find (x: X) (A: list X) : option nat :=
    match A with
    | nil => None
    | y :: A => if x == y then Some 0 else option_map S (find x A)
    end.

  Lemma find_Some x A n:
    find x A = Some n -> nth A n = Some x.
  Proof.
    induction A in n |-*; cbn.
    - discriminate.
    - destruct (x == a).
      injection 1; intros; subst. reflexivity.
      destruct find; try discriminate.
      cbn; injection 1; intros; subst.
      cbn. now rewrite IHA.
  Qed.

  Lemma find_in x A:
    x ∈ A -> exists n, find x A = Some n.
  Proof.
    induction A; cbn; intuition idtac.
    - exists 0. destruct (x == a); subst; intuition easy.
    - destruct (x == a).
      + subst; exists 0; intuition easy.
      + destruct H as [m]; exists (S m); intuition idtac.
        rewrite H; reflexivity.
  Qed.

  Lemma find_not_in x A:
    find x A = None -> ~ x ∈ A.
  Proof.
    intros H [n H'] % find_in; rewrite H in H'; discriminate.
  Qed.

End Find.

Section Remove.

  Variable (X: Type) (D: Dis X).

  Lemma remove_remain  (x y: X) A:
    x ∈ A -> x <> y -> x ∈ remove eq_dec y A.
  Proof.
    induction A; cbn; intuition idtac; subst.
    - destruct (y == x); subst; intuition (auto with datatypes).
    - destruct (y == a); subst; intuition (auto with datatypes).
  Qed.

  Lemma remove_prev (x y: X) (A: list X):
    y ∈ remove eq_dec x A -> y ∈ A.
  Proof.
    induction A; intuition idtac.
    cbn in H. destruct (x == a); subst; intuition (auto with datatypes).
    cbn in *; intuition easy.
  Qed.

End Remove.

Section FlatMap.

  Variable (X Y: Type).
  Implicit Types (A B: list X) (f: X -> list Y).

  Lemma flat_map_incl (f: X -> list Y) A B:
    A ⊆ B -> flat_map f A ⊆ flat_map f B.
  Proof.
    intros H x [y []] % in_flat_map.
    eapply in_flat_map; exists y; intuition auto.
  Qed.

  Lemma flat_map_in_incl f a A:
    a ∈ A -> f a ⊆ flat_map f A.
  Proof.
    revert A; eapply in_ind; cbn; intuition (auto with datatypes).
  Qed.

End FlatMap.


(* KENO FISCHER *)

(* Collaborators: Jao-ke Chin-Lee *)

(* CS250 Problem Set 0:  Basic Functional Programming in Coq

Due:  Tuesday 9/9 at Midnight

The goal of this problem set is to just get you comfortable
with the basic syntax of Coq, using ProofGeneral or the CoqIDE
in an interactive fashion, and to remember some basic functional
programming.

Feel free to collaborate with each other, but make sure to do
the exercises yourself so you start to become familiar with the
syntax and the environment.  If you get stuck, as questions
on Piazza, or come see me (MD151) or one of the students in MD309
to get un-stuck.

Complete each of the definitions below, and add some test cases
(using [Eval compute in <exp>.] to make sure they are working
properly.

Make sure to push your solution back to your cloned repository,
but only after you've added your name!
*)
Require Import Arith.
Require Import List.
Import ListNotations.

(* 0. Write a function [length] to compute the length of list.
      [length : forall {A:Type}, list A -> nat]
*)
Fixpoint length {A:Type} (l:list A) : nat :=
  match l with
    | [] => 0
    | (_::tl) => S (length tl)
  end.

Eval compute in (length [1;2;3;4]).

(* 1. Write a function [rev] that reverses a list.
      [rev : forall {A:Type}, list A -> list A]
*)

Fixpoint rev {A:Type} (l:list A) : list A :=
  match l with
    | [] => []
    | (hd::tl) => (rev tl) ++ [hd]
  end.

Eval compute in (rev [1;2;3;4]).

(* 2. Write a function [ith] that returns the ith element of a list,
      if the list has enough elements, and otherwise returns None.
      We are working zero-based, so for instance,
      [ith 2 (1::2::3::4::nil)] should return [Some 3], whereas
      [ith 4 (1::2::3::4::nil)] should return None.

      [ith : forall {A:type}, nat -> list A -> option A]
*)

Fixpoint ith {A:Type} (n:nat) (l:list A) : option A :=
  match n with
    | 0 => find (fun (x:A) => true) l
    | S k => (ith k (tail l))
  end.

Eval compute in (ith 2 (1::2::3::4::nil)).
Eval compute in (ith 4 (1::2::3::4::nil)).

(* 3. Write a generic function [comp] to compose two functions.
      [comp : forall {A B C:Type}, (A -> B) -> (B -> C) -> (A -> C)]
*)
Definition comp {A B C: Type} (f:A->B) (g:B->C) : (A->C) :=
  (fun (x:A) => (g (f x))).

Definition add_pair (x:nat*nat) :=
  (fst x)+(snd x).

Eval compute in ((comp (fun (x:nat*nat) => ((fst x),(add_pair x))) add_pair) (1,2)).

(* 4. Write a function [sum] that adds up all of the [nat]s in a list.
      [sum : list nat -> nat]
*)
Fixpoint sum (l: list nat) : nat :=
  match l with
    | [] => 0
    | hd::tl => hd + (sum tl)
  end.

Eval compute in (sum [1;2;3;4]).

(* 5. Write a function that [map] that maps a function over the
      elements in a list, producing a new list.
      [map : forall {A B:Type}, (A -> B) -> list A -> list B]
*)
Fixpoint map {A B:Type} (f:A->B) (l:list A) : list B :=
  match l with
    | [] => []
    | hd::tl => [(f hd)] ++ (map f tl)
  end.

Eval compute in (map (fun (x:nat) => match x with
    | 0 => 0
    | S k => k
    end) [0;1;2;3;4]).

(* 6. Write a generic "fold-right" for a list such that, for instance.
      [fold (fun x y => x + y) 0 (1::2::3::nil)] evaluates to [6].
      [fold : forall {A B:Type}, (A -> B -> B) -> B -> list A -> B]
*)
Fixpoint fold {A B:Type} (f:(A->B->B)) (acc:B) (l:list A) : B :=
  match l with
    (* Not part of the recursion but for the empty case *)
    | [] => acc
    | (hd::tl) => (f hd (fold f acc tl))
  end.

Eval compute in (fold (fun x y => x + y) 0 (1::2::3::nil)).

(* 7. Write a function add_pairs that takes a list of pairs of nats and
      returns the list of the corresponding sums.  For instance,
      [add_pairs ((1,2)::(3,4)::nil)] should return [3::7::nil].
      [add_pairs : list (nat * nat) -> list nat]
*)
Definition add_pairs (l:list (nat * nat)) : list nat :=
  (map (fun (p:(nat*nat)) => (add_pair p)) l).

Eval compute in (add_pairs ((1,2)::(3,4)::nil)).

(* 8. Given the following definition for trees: *)
Inductive tree (A:Type) : Type :=
| Leaf : tree A
| Node : tree A -> A -> tree A -> tree A.

Implicit Arguments Leaf [A].  (* Ask Coq to synthesis the type argument to Leaf *)
Implicit Arguments Node [A].  (* Ditto for Node *)

(* 9. Write a function which flattens the tree into a list.
      For instance, flatten on the tree:

                   3
                 /   \
                1     7
              /  \   /  \
             o    o o    o

   should yield [1::3::7::nil].
   [flatten : forall {A:Type}, tree A -> list A]
*)
Fixpoint flatten {A:Type} (t:tree A) : list A :=
  match t with
    | Leaf => []
    | (Node t1 x t2) => (flatten t1) ++ [x] ++ (flatten t2)
  end.

Definition tree1:tree nat := (Node (Node Leaf 1 Leaf) 3 (Node Leaf 7 Leaf)).
Definition tree2 := (Node (Node Leaf 5 Leaf) 3 (Node Leaf 7 Leaf)).
Definition tree3 := (Node tree1 8 tree2).

Eval compute in (flatten tree1).
Eval compute in (flatten tree2).
Eval compute in (flatten tree3).
Eval compute in (flatten (@Leaf nat)).

Inductive order : Type :=
| Less
| Equal
| Greater.

(* 11. Write a function which when given two numbers n and m,
       returns [Less] if n < m, [Equal] if n = m, and otherwise
       returns [Greater].
       [nat_cmp : nat -> nat -> order] *)

Fixpoint nat_cmp (a:nat) (b:nat) : order :=
  match a,b with
    | 0, S k    => Less
    | 0, 0      => Equal
    | S k, 0    => Greater
    | S x, S y  => (nat_cmp x y)
  end.

Notation "a < b" :=
  match (nat_cmp a b) with Less => true | _ => false end.

Eval compute in (1 < 2).
Eval compute in (nat_cmp 2 2).
Eval compute in (nat_cmp 3 2).

(* 12. Write a function that determines whether a [tree nat] is
       a valid search tree in the sense that for a given node
       with value [n], all elements in the left sub-tree should
       be less than [n] and all elements in the right sub-tree
       should be greater than [n].
       [search_tree : tree nat -> bool]
*)

Definition helper (a:nat) (p:bool*nat*bool) :=
  let '(acc,b,first) := p in ((orb first (andb acc (a<b))),a,false).

Definition search_tree (t: tree nat) : bool :=
  (fst (fst (fold helper (true,0,true) (flatten t)))).

Eval compute in (search_tree tree1).
Eval compute in (search_tree tree2).
Eval compute in (search_tree tree3).


(*Javier Enríquez Mendoza*)

Require Import Arith.

Fixpoint compara (n m : nat) : comparison :=
match n, m with
| 0, 0 => Eq
| S n', 0 => Gt
| 0 , S m' => Lt
| S n', S m' => compara n' m'
end.

Theorem eq : forall (n m : nat),compara n m = Eq <-> n = m.
Proof.
induction n.
destruct m; split;trivial.
discriminate.
discriminate.
destruct m.
split; discriminate.
simpl.
destruct IHn with m.
split.
intros.
apply H in H1.
rewrite H1.
trivial.
intros.
inversion H1.
rewrite H3 in H0.
apply H0.
trivial.
Qed.

Theorem Lt : forall (n m : nat), compara n m = Lt <-> n < m.
Proof.
induction n; destruct m; split; intro.
discriminate H.
unfold lt in H.
inversion H.
unfold lt.
apply le_n_S.
apply le_0_n.
reflexivity.
simpl in H.
discriminate H.
inversion H.
simpl in H.
unfold lt.
unfold lt in IHn.
apply le_n_S.
apply IHn.
trivial.
unfold lt in IHn.
destruct IHn with m.
unfold lt in H.
apply le_S_n in H.
apply H1 in H.
simpl.
trivial.
Qed.

Theorem Gt : forall (n m : nat), compara n m = Gt <-> n > m.
Proof.
induction n; destruct m; split; intro.
discriminate H.
unfold gt in H.
unfold lt in H.
inversion H.
discriminate H.
unfold gt in H.
unfold lt in H.
inversion H.
unfold gt.
unfold lt.
apply le_n_S.
apply le_0_n.
reflexivity.
destruct IHn with m.
simpl in H.
apply H0 in H.
unfold gt in H.
unfold gt.
unfold lt in H.
unfold lt.
apply le_n_S.
trivial.
simpl.
unfold gt in H.
unfold gt in IHn.
unfold lt in H.
unfold lt in IHn.
apply le_S_n in H.
apply IHn in H.
trivial.
Qed.


Require Import ZArith Arith Bool Omega.

Ltac caseEq f :=
  generalize (refl_equal f); pattern f at -1; case f.

Open Scope Z_scope.

(* The key to this corollary is that if s=Zsqrt_plain x, then
  s*s < (s+1) * (s+1), as stated by the companion theorem
  Zsqrt_interval, and the squaring operation is monotonic only
  for positive values. *)
Theorem sqrt_plain_pos : forall x:Z, 0 <= Zsqrt_plain x.
Proof.
 intros x; case x.
 simpl; auto with zarith.

 intros p.
 cut (0 < 2* Zsqrt_plain(Zpos p) + 1).
 intros; omega.

 replace (2* Zsqrt_plain(Zpos p) + 1) with
   ((Zsqrt_plain (Zpos p) + 1)*(Zsqrt_plain (Zpos p) + 1) -
   Zsqrt_plain (Zpos p) * Zsqrt_plain (Zpos p)).
 lapply (Zsqrt_interval (Zpos p)).
 omega.
 auto with zarith.
 ring.

 simpl; auto with zarith.
Qed.

Theorem div_Zsqrt :
 forall m n p:Z, 0 < m < n ->
  n=m*p-> 0 < m <= Zsqrt_plain n \/ 0 < p <= Zsqrt_plain n.
Proof.
 intros m n p Hint Heq.
 elim (Z_lt_le_dec (Zsqrt_plain n) m);
 elim (Z_lt_le_dec (Zsqrt_plain n) p).
 intros Hltm Hltp.
 assert (Hlem : (Zsqrt_plain n)+1 <= m).
 omega.
 assert (Hlep : (Zsqrt_plain n)+1 <= p).
 omega.
 elim (Zlt_irrefl n).
 apply Zlt_le_trans with (((Zsqrt_plain n)+1)*((Zsqrt_plain n)+1)).
 assert (Hposn : 0 <= n).
 omega.
 Check Zsqrt_interval.
 generalize (Zsqrt_interval n); intuition.
 pattern n at 3; rewrite Heq.

 apply Zmult_le_compat; try omega.

 generalize (sqrt_plain_pos n); omega.

 generalize (sqrt_plain_pos n); omega.

 intros Hple _; right; split; auto.

 apply Zmult_lt_0_reg_r with m; try tauto.
 rewrite Zmult_comm; omega.

 intros _ Hmle; left; split; tauto.
 intros _ Hmle; left; split; tauto.
Qed.

Definition divides_bool (p t:Z) : bool :=
 match t mod p with
   0 => true
 | _ => false
 end.

Fixpoint test_odds (n:nat) (p t:Z) {struct n} : bool :=
 match n with
   0%nat => negb (divides_bool 2 t)
 | S n' =>
   if test_odds n' (p - 2) t then negb (divides_bool p t) else false
 end.

Definition prime_test (n:nat) : bool :=
 match n with
   0%nat => false
 | 1%nat => false
 | S (S n) =>
  let x := (Z_of_nat (S (S n))) in
  let s := (Zsqrt_plain x) in
  let (half_s, even_bit) :=
    match s with
    | Zpos(xI h) => (Zpos h, 0)
    | Zpos(xO h) => (Zpos h, 1)
    | Zpos xH => (0, 0)
    | _ => (0, 1)
    end  in
  test_odds (Zabs_nat half_s) (s + even_bit) x
 end.

Time Eval lazy beta iota delta zeta in (prime_test 2333).

(* Time Eval compute in (prime_test 2333).

  This command takes a much longer time.  The reason is that Zsqrt_plain
  calls a strongly specified function, which builds a proof term that is
  large, but is discarded later.  Lazy computation avoid the useless
  work. *)

(* we use the same axiom as in the book, it is corrected in another exercise.
 *)

Axiom verif_divide :
  (forall m p:nat, 0 < m -> 0 < p ->
   (exists q:nat, m = q*p) ->(Z_of_nat m mod Z_of_nat p = 0)%Z )%nat.

(* This axiom is actually a lemma used in the same other exercise. *)

Axiom Z_to_nat_and_back :
 forall x:Z, (0 <= x)%Z -> (Z_of_nat (Zabs_nat x))=x.

Theorem test_odds_correct2 :
  forall n x:nat,
    (1 < x)%nat ->
  forall p:Z,
    test_odds n p (Z_of_nat x) = true ->
    ~(exists y:nat, x = y*2)%nat.
Proof.
 intros n; elim n.
 unfold test_odds, divides_bool; intros x H1ltx _ Heq Hex.
 assert (Heq' : Z_of_nat x mod Z_of_nat 2 = 0).
 apply verif_divide; auto with zarith.
 simpl (Z_of_nat 2) in Heq'; rewrite Heq' in Heq; simpl in Heq; discriminate.

 clear n; intros n IHn x H1ltx p; simpl.
 caseEq (test_odds n (p - 2) (Z_of_nat x)).
 intros Htest' _ ; apply (IHn x H1ltx (p -2)); auto.
 intros; discriminate.
Qed.

Theorem Z_of_nat_le :
  forall x y, Z_of_nat x <= Z_of_nat y -> (x <= y)%nat.
Proof.
 intros; omega.
Qed.

Theorem test_odds_correct :
  forall (n x:nat)(p:Z),
   p = 2*(Z_of_nat n)+1 ->
   (1 < x)%nat -> test_odds n p (Z_of_nat x) = true ->
   forall q:nat, (1 < q <= 2*n+1)%nat -> ~(exists y:nat, x = q*y)%nat.
Proof.
 induction n.
 intros x p Hp1 H1ltx Hn q Hint.
 assert (H:False).
 omega.
 elim H.

 intros x p Hp H1ltx; simpl (test_odds (S n) p (Z_of_nat x));
 intros Htest q (H1ltq, Hqle).
 caseEq (test_odds n (p -2) (Z_of_nat x)).
 intros Htest'true.
 rewrite Htest'true in Htest.
 unfold divides_bool in Htest.
 elim (le_lt_or_eq q (2*S n + 1)%nat Hqle).
 intros Hqlt.
 assert (Hqle': (q <= (2* S n))%nat).
 omega.
 elim (le_lt_or_eq q (2 * S n)%nat Hqle').
 replace (2*S n)%nat with (2*n +2)%nat.
 intros Hqlt'.
 assert (Hqle'' : (q <= 2*n +1)%nat).
 omega.
 apply (IHn x (p - 2)); auto with zarith arith.
 rewrite Hp; rewrite inj_S; unfold Zsucc; ring.
 ring.
 intros Hq (y, Hdiv); elim (test_odds_correct2 n x H1ltx (p - 2)); auto.
 exists (S n * y)%nat; rewrite Hdiv; rewrite Hq; ring.

 intros Hq Hex; assert (Hp' : p = Z_of_nat q).
 rewrite Hp; rewrite Hq; rewrite inj_plus; rewrite inj_mult; auto.
 rewrite Hp' in Htest; rewrite (verif_divide x q) in Htest.
 simpl in Htest; discriminate.
 omega.
 omega.
 elim Hex; intros y Hdiv; exists y; rewrite Hdiv; ring.
 intros Htest'; rewrite Htest' in Htest; simpl in Htest; discriminate.
Qed.

Axiom divisor_smaller :
  (forall m p:nat, 0 < m -> forall q:nat, m = q*p -> q <= m)%nat.

Theorem lt_Zpos : forall p:positive, 0 < Zpos p.
Proof.
 intros p; elim p.
 intros; rewrite Zpos_xI; omega.
 intros; rewrite Zpos_xO; omega.
 auto with zarith.
Qed.

Theorem Zneg_lt : forall p:positive, Zneg p < 0.
Proof.
 intros p; elim p.
 intros; rewrite Zneg_xI; omega.
 intros; rewrite Zneg_xO; omega.
 auto with zarith.
Qed.

Theorem prime_test_correct :
 forall n:nat, prime_test n = true ->
 ~(exists k:nat, k <> 1 /\ k <> n /\ (exists q:nat, n = q*k))%nat.
Proof.
 intros n.
 caseEq n.

 simpl;  intros Heq Hd; discriminate.
 intros n0; caseEq n0.
 simpl; intros Heq1 Heq2 Hd; discriminate.

 unfold prime_test; intros n1 Heqn0 Heqn.
 assert (H1ltn : (1 < n)%nat).
 rewrite Heqn; auto with arith.

 rewrite <- Heqn.
 lazy beta zeta delta [prime_test].
 caseEq (Zsqrt_plain (Z_of_nat n)).
 intros Hsqrt_eq.
 elim (Zlt_asym 1 (Z_of_nat n)).
 omega.
 lapply (Zsqrt_interval (Z_of_nat n)).
 rewrite Hsqrt_eq; simpl.
 omega.
 omega.

 intros p Hsqrt_eq Htest_eq (k, (Hn1, (Hnn, (q,Heq)))).
 assert (H0ltn:(0 < n)%nat).
 omega.

 assert (Hkltn:(k < n)%nat).
 assert (Heq' : n=(k*q)%nat).
 rewrite Heq; ring.

 generalize (divisor_smaller n q H0ltn k Heq').
 omega.

 assert (Hex: exists k':nat, (1 < (Z_of_nat k') <= (Zsqrt_plain (Z_of_nat n))) /\
               (exists q':nat, n=(k'*q')%nat)).
 elim (div_Zsqrt (Z_of_nat k) (Z_of_nat n) (Z_of_nat q)).

 intros Hint1; exists k;split.
 omega.
 exists q; rewrite Heq; ring.

 intros Hint2; exists q; split.
 split.
 elim (Zle_or_lt (Z_of_nat q) 1); auto.

 intros hqle1.
 assert (Hq1: q = 1%nat).
 omega.

 rewrite Hq1 in Heq; simpl in Heq; elim Hnn; rewrite Heq; ring.
 tauto.

 exists k; auto.

 split.
 caseEq k.
 intros Hk0; rewrite Hk0 in Heq; rewrite Heq in H1ltn; rewrite mult_0_r in H1ltn;
 omega.

 intros; unfold Zlt; simpl; auto.

 omega.

 rewrite Zmult_comm; rewrite <- inj_mult; rewrite Heq;auto.

 elim Hex; intros k' ((H1ltk', Hk'ltsqrt), Hex'); clear Hex.

 caseEq p.

 intros p' Hp; rewrite Hp in Htest_eq.

 elim (test_odds_correct (Zabs_nat (Zpos p'))
           n (Zpos p)) with k'.

 rewrite Z_to_nat_and_back.

 rewrite Hp.
 auto with zarith.
 auto with zarith.
 auto.

 repeat rewrite Zminus_0_r in Htest_eq.
 rewrite Hp; auto.
 split.
 omega.

 apply Z_of_nat_le.

 rewrite inj_plus.
 rewrite inj_mult.
 rewrite Z_to_nat_and_back.
 simpl (Z_of_nat 2).
 simpl (Z_of_nat 1).
 rewrite <- Zpos_xI.
 rewrite <- Hp.
 rewrite <- Hsqrt_eq; auto.

 auto with zarith.
 auto.

 intros p' Hp; rewrite Hp in Htest_eq.

 elim (test_odds_correct (Zabs_nat (Zpos p')) n (Zpos p + 1))
  with k'.

 rewrite Z_to_nat_and_back.
 rewrite Hp; rewrite Zpos_xO; ring.

 generalize (lt_Zpos p'); intros; omega.

 auto.

 rewrite <- Hp in Htest_eq; auto.

 split; try omega.

 apply Z_of_nat_le.

 rewrite inj_plus.
 rewrite inj_mult.
 rewrite Z_to_nat_and_back.

 simpl (Z_of_nat 2); simpl (Z_of_nat 1).
 rewrite <- Zpos_xO.
 rewrite <- Hp; omega.

 auto with zarith.
 auto.

 intros Hp; rewrite Hp in Hsqrt_eq.
 rewrite Hsqrt_eq in Hk'ltsqrt.

 omega.

 intros p Hsqrt_eq.
 elim (Zle_not_lt 0 (Zsqrt_plain (Z_of_nat n))).

 apply sqrt_plain_pos.

 rewrite Hsqrt_eq.

 apply Zneg_lt.
Qed.


Require Export Lci.
Require Export misc.

Section groups.

Variable S : Set.
Variable G : S -> Prop.
Variable Add : S -> S -> S.
Variable O : S.
Variable Opp : S -> S.

Definition is_group :=
  intern S G Add /\
  associativity S Add /\ neutral S G Add O /\ opposite S G Add O Opp.

Lemma regular_l :
 is_group ->
 forall y z : S,
 G y -> G z -> forall x : S, G x -> Add x y = Add x z -> y = z.
Proof.
intros.
elim H; intros; elim H5; intros; elim H7; intros; elim H8; intros.
clear H4 H5 H7 H10.
(* use of neutral *)
elim (H11 y H0); intros; elim H5; clear H4 H5.
elim (H11 z H1); intros; elim H5; clear H4 H5 H8 H11.
(* use of opposite *)
elim (H9 x H2); intros; elim H5; intros; elim H8; intros; elim H11.
clear H4 H5 H7 H8 H9 H10 H11.
(* use of associativity *)
elim (H6 (Opp x) x y); elim (H6 (Opp x) x z).
elim H3; reflexivity.
Qed.

Lemma add_add :
 commutativity S Add ->
 associativity S Add ->
 forall x1 y1 x2 y2 : S,
 Add (Add x1 y1) (Add x2 y2) = Add (Add x1 x2) (Add y1 y2).
Proof.
intros com ass x1 y1 x2 y2.
rewrite (ass (Add x1 y1) x2 y2); elim (ass x1 y1 x2); elim (com x2 y1).
rewrite (ass x1 x2 y1); elim (ass (Add x1 x2) y1 y2); reflexivity.
Qed.

Lemma opp_unicity :
 is_group -> forall x y : S, is_opposite S G Add O x y -> y = Opp x.
Proof.
intros.
(* [G y] *)
elim H0; intros; elim H2; intros.
(* [y = 0+y] *)
elim H; intros; elim H6; intros; elim H8; intros; elim H9; intros.
elim (H12 y H3); intros; elim H14; clear H H2 H3 H5 H6 H8 H11 H12 H13 H14.
(* [0=(-x)+x] *)
elim (H10 x H1); intros; elim H2; intros; elim H5; intros; elim H8.
clear H H1 H2 H5 H6 H8 H10.
(* [((-x)+x)+y=(-x)+(x+y)] *)
elim (H7 (Opp x) x y).
(* [x+y = 0] *)
elim H4; intros; rewrite H; clear H H0 H1 H4 H7.
(* [(-x)+0=(-x)] *)
elim H9; intros; elim (H0 (Opp x) H3); intros. exact H1.
Qed.

Lemma opp_opp : is_group -> forall x : S, G x -> x = Opp (Opp x).
Proof.
intros.
apply (opp_unicity H (Opp x) x).
unfold is_opposite in |- *; split.
elim H; intros; elim H2; intros; elim H4; intros; elim (H6 x H0); intros.
elim H8; trivial.
elim H; intros; elim H2; intros; elim H4; intros; elim (H6 x H0); intros.
elim H8; intros; elim H10; auto.
Qed.

Lemma opp_add :
 is_group ->
 commutativity S Add ->
 forall x y : S, G x -> G y -> Opp (Add x y) = Add (Opp x) (Opp y).
Proof.
intros; symmetry  in |- *;
 apply (opp_unicity H (Add x y) (Add (Opp x) (Opp y))).
unfold is_opposite in |- *; split.
(* [G (x+y)] *)
elim H; intros; apply (H3 x y H1 H2).
split.
(* [G ((-x)+(-y))] *)
elim H; intros; elim H4; intros; elim H6; intros; clear H4 H5 H6 H7.
elim (H8 x H1); intros; elim H5; intros; clear H4 H5 H7.
elim (H8 y H2); intros; elim H5; intros.
apply (H3 (Opp x) (Opp y) H6 H7).
(* [(x+y)+((-x)+(-y)) = 0 & ((-x)+(-y))+(x+y) = 0] *)
elim H; intros; elim H4; intros; clear H3 H4 H6.
rewrite (add_add H0 H5 x y (Opp x) (Opp y)).
rewrite (add_add H0 H5 (Opp x) (Opp y) x y); clear H5.
elim H; intros; elim H4; intros; elim H6; intros.
  (* [x+(-x) = 0 (-x)+x = 0] *)
elim (H8 x H1); intros; elim H10; intros; elim H12; intros.
rewrite H13; rewrite H14.
clear H H0 H1 H3 H4 H5 H6 H9 H10 H11 H12 H13 H14.
  (* [y+(-y) = 0 (-y)+y = 0] *)
elim (H8 y H2); intros; elim H0; intros; elim H3; intros.
rewrite H4; rewrite H5.
clear H H0 H1 H2 H3 H4 H5 H8.
  (* [0+0 = 0] *)
elim H7; intros; exact (H0 O H).
Qed.

Lemma opp_neutral : is_group -> Opp O = O.
Proof.
intros.
elim (opp_unicity H O O).
reflexivity.
unfold is_opposite in |- *.
elim H; intros; elim H1; intros; elim H3; intros; elim H4; intros.
elim (H7 O H6); auto.
Qed.

End groups.


(* Implementation and correctness proof for insertion sort.
  Andrew W. Appel, January 2010. *)

Require Import Permutation.
Require Import SfLib.

Notation "[ ]" := nil.
Notation "[ x , .. , y ]" := (cons x .. (cons y nil) ..).

Theorem ble_nat_refl: forall m, ble_nat m m = true.
Proof.
  intros. induction m as [| m'].
  Case "m = 0".
  reflexivity.
  Case "m = S m'".
  apply IHm'.
Qed.

Theorem ble_nat_i: forall n m, n <= m -> ble_nat n m = true.
Proof.
induction n as [|n']; intros; simpl; auto.
destruct m.
elimtype False.
omega.
apply IHn'.
omega.
Qed.

Theorem false_ble_nat_i:  forall n m, n > m -> ble_nat n m = false.
Proof.
intros.
remember (ble_nat n m) as p; destruct p; auto.
symmetry in Heqp; apply ble_nat_true in Heqp; elimtype False; omega.
Qed.

Theorem false_ble_nat_e: forall n m, ble_nat n m = false -> n > m.
Proof.
intros.
assert (n <= m \/ n > m) by omega.
destruct H0; auto.
apply ble_nat_i in H0.
rewrite H0 in H.
inversion H.
Qed.

(* PART I.   Prove correctness of functional program for insertion sort  *)

Fixpoint insert (i:nat) (l: list nat) :=
  match l with
  | nil => i::nil
  | h::t => if ble_nat i h then i::h::t else h :: insert i t
 end.

Fixpoint sort (l: list nat) : list nat :=
  match l with
  | nil => nil
  | h::t => insert h (sort t)
end.

Example sort_pi: sort [3,1,4,1,5,9,2,6,5,3,5] = [1,1,2,3,3,4,5,5,5,6,9].
Proof.
simpl.
reflexivity.
Qed.

(** **** Exercise: 3 stars *)

(* Prove an auxiliary lemma insert_perm, useful for proving sort_perm.
  You may want to get into the proof of sort_perm first, to see what you'll need.  *)
Theorem insert_perm_l: forall l i, Permutation (i::l) (insert i l).
Proof.
  intros. induction l as [| x xs].
  reflexivity.
  simpl. destruct (ble_nat i x).
    reflexivity.
    rewrite <- IHxs. apply perm_swap.
Qed.

Theorem insert_perm: forall l l' i,
  Permutation l l' -> Permutation (i::l) (insert i l').
Proof.
  intros. destruct l' as [| y ys].
    simpl. apply perm_skip. apply H.
    destruct l.
      apply Permutation_nil in H. rewrite H. reflexivity.
      rewrite H. apply insert_perm_l.
Qed.

(** **** Exercise: 3 stars *)
(* Now prove the main theorem. *)
Theorem sort_perm: forall l, Permutation l (sort l).
Proof.
  intros. induction l as [| x xs].
    reflexivity.
    apply insert_perm. assumption.
Qed.
(** [] *)

(** **** Exercise: 3 stars *)
(* Define an inductive predicate "sorted" that tells whether a list of nats is in nondecreasing order.
   Then prove that "sort" produces a sorted list.
*)
Inductive sorted: list nat -> Prop :=
  | sorted_nil : sorted []
  | sorted_cons1 x : sorted [x]
  | sorted_cons x y l : sorted (y::l) -> ble_nat x y = true -> sorted (x::y::l).

Theorem sorted_zero: forall l, sorted l -> sorted (0 :: l).
Proof.
  intros. induction l as [| x xs].
    apply sorted_cons1.
    inversion H.
      apply sorted_cons.
        apply sorted_cons1.
        reflexivity.
      rewrite H1.
      apply sorted_cons.
        apply H.
        reflexivity.
Qed.

Theorem sorted_rest: forall l i, sorted (i :: l) -> sorted l.
Proof.
  intros. induction l as [| x xs].
    apply sorted_nil.
    inversion H. apply H2.
Qed.

Theorem ble_nat_flip: forall i x, ble_nat i x = false -> ble_nat x i = true.
Proof.
  intros. generalize dependent x.
  induction i as [| i'].
  Case "i = 0".
  destruct x.
    reflexivity.
    intros. inversion H.
  Case "i = S i'".
  induction x.
    reflexivity.
    intros. simpl. apply IHi'.
    inversion H. reflexivity.
Qed.

Theorem insert_sorted: forall l i, sorted l -> sorted (insert i l).
Proof.
  intros.
  induction l as [| x xs].
    simpl. constructor.
    simpl. destruct (ble_nat i x) eqn:Heqe.
      constructor. assumption. assumption.
      inversion H; subst.
        simpl. constructor. constructor.
          apply ble_nat_flip. apply Heqe.
        simpl. simpl in IHxs.
        simpl. destruct (ble_nat i y) eqn:Heqe2.
          constructor.
          constructor. apply H2. apply Heqe2.
          apply ble_nat_flip. apply Heqe.
          constructor. apply IHxs. apply H2. apply H3.
Qed.

(* You may want to first prove an auxiliary lemma about inserting an element
   into a sorted list.  *)
Theorem sort_sorted: forall l, sorted (sort l).
Proof.
  intros. induction l as [| x xs].
    apply sorted_nil.
    apply insert_sorted. apply IHxs.
Qed.
(** [] *)


(* Basics *)

(* Days of week *)
Inductive day : Type :=
  | monday : day
  | tuesday : day
  | wednesday : day
  | thursday : day
  | friday : day
  | saturday : day
  | sunday : day.

Definition next_weekday (d:day) : day :=
  match d with
  | monday => tuesday
  | tuesday => wednesday
  | wednesday => thursday
  | thursday => friday
  | friday => monday
  | saturday => monday
  | sunday => monday
  end.

Compute (next_weekday friday).

Compute (next_weekday (next_weekday saturday)).

Example test_next_weekday :
  (next_weekday (next_weekday saturday)) = tuesday.
Proof. simpl. reflexivity. Qed.

(*
* The assertion we've just made can be proved by observing
* that both sides of the equality evaluate to the same thing,
* after some simplification.
*)

(* Booleans *)
Inductive bool : Type :=
  | true : bool
  | false : bool.

Definition negb (b:bool) : bool :=
  match b with
  | true => false
  | false => true
  end.

Definition andb (b1:bool) (b2:bool) : bool :=
  match b1 with
  | true => b2
  | false => false
  end.

Definition orb (b1:bool) (b2:bool) : bool :=
  match b1 with
  | true => true
  | false => b2
  end.

Example test_orb1: (orb true false) = true.
Proof. simpl. reflexivity. Qed.
Example test_orb2: (orb false false) = false.
Proof. simpl. reflexivity. Qed.
Example test_orb3: (orb false true) = true.
Proof. simpl. reflexivity. Qed.
Example test_orb4: (orb true true) = true.
Proof. simpl. reflexivity. Qed.

Infix "&&" := andb.
Infix "||" := orb.

Example test_orb5: false || false || true = true.
Proof. simpl. reflexivity. Qed.

(* Exercise: nandb *)
Definition nandb (b1:bool) (b2:bool) : bool :=
  negb (b1 && b2).

Example test_nandb1: (nandb true false) = true.
Proof. simpl. reflexivity. Qed.
Example test_nandb2: (nandb false false) = true.
Proof. simpl. reflexivity. Qed.
Example test_nandb3: (nandb false true) = true.
Proof. simpl. reflexivity. Qed.
Example test_nandb4: (nandb true true) = false.
Proof. simpl. reflexivity. Qed.

(* Exercise: andb3 *)
Definition andb3 (b1:bool) (b2:bool) (b3:bool) : bool :=
  (andb (andb b1 b2) b3).

Example test_andb31: (andb3 true true true) = true.
Proof. simpl. reflexivity. Qed.
Example test_andb32: (andb3 false true true) = false.
Proof. simpl. reflexivity. Qed.
Example test_andb33: (andb3 true false true) = false.
Proof. simpl. reflexivity. Qed.
Example test_andb34: (andb3 true true false) = false.
Proof. simpl. reflexivity. Qed.

(* Function Types *)

Check true.

Check (negb true).

Check negb.

Module Playground1.

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

Definition pred (n:nat) : nat :=
  match n with
    | O => O
    | S n' => n'
  end.

End Playground1.

Definition minustwo (n:nat) : nat :=
  match n with
  | O => O
  | S O => O
  | S (S n') => n'
  end.

Check (S (S (S (S O)))).
Compute (minustwo 4).

Check S.
Check pred.
Check minustwo.

Fixpoint evenb (n:nat) : bool :=
  match n with
  | O => true
  | S O => false
  | S (S n') => evenb n'
  end.

Definition oddb (n:nat) : bool := negb (evenb n).

Example test_oddb1: oddb 1 = true.
Proof. simpl. reflexivity. Qed.

Example test_oddb2: oddb 2 = false.
Proof. simpl. reflexivity. Qed.

Module Playground2.

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

Compute (plus 3 2).

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

Example test_mult1: (mult 3 3) = 9.
Proof. simpl. reflexivity. Qed.

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

End Playground2.

Fixpoint exp (base power : nat) : nat :=
  match power with
  | O => S O
  | S p => mult base (exp base p)
  end.

(* Exercise: factorial *)
Fixpoint fact (n : nat) : nat :=
  match n with
  | O => S O
  | S n' => mult (S n') (fact n')
  end.

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

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

Notation "x * y" := (mult x y)
  (at level 40, left associativity)
  : nat_scope.

Check ((0+1)+1).

Fixpoint beq_nat (n m : nat) : bool :=
  match n with
  | O => match m with
         | O => true
         | S m' => false
         end
  | S n' => match m with
            | O => false
            | S m' => beq_nat n' m'
            end
end.

Fixpoint leb (n m : nat) : bool :=
  match n with
  | O => true
  | S n' => match m with
            | O => false
            | S m' => leb n' m'
            end
  end.
Check leb.

Example test_leb1: (leb 2 2) = true.
Proof. simpl. reflexivity. Qed.

Example test_leb2: (leb 2 4) = true.
Proof. simpl. reflexivity. Qed.

Example test_leb3: (leb 4 2) = false.
Proof. simpl. reflexivity. Qed.

(* Exercise: blt_nat *)
Definition blt_nat (n m : nat) : bool :=
  (leb n m) && (negb (beq_nat n m)).

Example test_blt_nat1: (blt_nat 2 2) = false.
Proof. simpl. reflexivity. Qed.

Example test_blt_nat2: (blt_nat 2 4) = true.
Proof. simpl. reflexivity. Qed.

Example test_blt_nat3: (blt_nat 4 2) = false.
Proof. simpl. reflexivity. Qed.

(* Proof by Simplification *)
(* use simpl to simplify both sides of the equation, then use reflexivity to check that both sides contain identical values. *)

Theorem plus_0_n' : forall n : nat, 0 + n = n.
Proof. intros n. simpl. reflexivity. Qed.

Theorem plus_1_l : forall n : nat, 1 + n = S n.
Proof. intros n. reflexivity. Qed.

Theorem mult_0_l : forall n : nat, 0 * n = 0.
Proof. intros n. reflexivity. Qed.

(* Proof by Rewriting *)
Theorem plus_id_example : forall n m : nat,
  n = m -> n + n = m + m.
Proof.
  (* move both the quantifiers into the context *)
  intros n m.
  (* move the hypothesis into the context *)
  intros H.
  (* rewrite the goal using the hypothesis *)
  rewrite -> H.
  reflexivity.
Qed.

(*
The first line of the proof moves the universally quantified variables n and m into the context.
The second moves the hypothesis n = m into the context and gives it the name H.
The third tells Coq to rewrite the current goal (n + n = m + m) by replacing the left side of the equality hypothesis H with the right side.
*)

(* Exercise 1*)
Theorem plus_id_exercise : forall n m o : nat,
  n = m -> m = o -> n + m = m + o.
Proof.
  intros n m o.
  intros H1.
  intros H2.
  rewrite -> H1.
  rewrite -> H2.
  reflexivity.
Qed.

(* Exercise 2*)
Theorem mult_S_1 : forall n m : nat,
  m = S n ->
  m * (1 + n) = m * m.
Proof.
  intros n m.
  intros H.
  rewrite -> H.
  reflexivity.
Qed.

(* Proof by Case Analysis *)
Theorem plus_1_neq_0 : forall n : nat,
  beq_nat (n + 1) 0 = false.
Proof.
  intros n.
  destruct n as [| n'].
  - reflexivity.
  - reflexivity.
Qed.

Theorem negb_involutive : forall b : bool,
  negb (negb b) = b.
Proof.
  intros b.
  destruct b.
  - reflexivity.
  - reflexivity.
Qed.

Theorem andb_commutative : forall b c,
  andb b c = andb c b.
Proof.
  intros b c.
  destruct b.
  - destruct c.
    + reflexivity.
    + reflexivity.
  - destruct c.
    + reflexivity.
    + reflexivity.
Qed.

(* Exercise *)
Theorem andb_true_elim2 : forall b c : bool,
  andb b c = true -> c = true.
Proof.
  intros b c H.
  destruct c.
    - reflexivity.
    - rewrite <- H.
      destruct b.
      + reflexivity.
      + reflexivity.
Qed.

(*
It tells Coq what variable names to introduce in each subgoal. In general, what goes between the square brackets is a list of lists of names, separated by |. In this case, the first component is empty, since the O constructor is nullary (it doesn't have any arguments). The second component gives a single name, n', since S is a unary constructor.  *)
Theorem zero_nbeq_plus_1 : forall n : nat,
  beq_nat 0 (n + 1) = false.
Proof.
  intros n.
  destruct n as [| n']. (* intro pattern *)
  - reflexivity.
  - reflexivity.
Qed.

Theorem identity_fn_applied_twice :
  forall (f : bool -> bool),
  (forall (x : bool), f x = x) ->
  forall (b : bool), f (f b) = b.
Proof.
  intros f H.
  destruct b.
  - rewrite H. rewrite H. reflexivity.
  - rewrite H. rewrite H. reflexivity.
Qed.

Theorem negation_fn_applied_twice :
  forall (f : bool -> bool),
  (forall (x : bool), f x = negb x) ->
  forall (b : bool), f (f b) = b.
Proof.
  intros f H.
  destruct b.
  - rewrite H. rewrite H. reflexivity.
  - rewrite H. rewrite H. reflexivity.
Qed.

Theorem andb_eq_orb :
  forall (b c : bool),
  (andb b c = orb b c) ->
  b = c.
Proof.
  intros b c.
  unfold andb.
  intros H.
  destruct b.
  - rewrite H. reflexivity.
  - rewrite H. reflexivity.
Qed.

Inductive bin : Type :=
| Zero : bin
| TwiceOf : bin -> bin
| OneMoreTwiceOf : bin-> bin.

Fixpoint incr (b : bin) : bin :=
match b with
| Zero => OneMoreTwiceOf Zero
| TwiceOf b' => OneMoreTwiceOf b'
| OneMoreTwiceOf b' => TwiceOf (incr b')
end.

(*
0 => Zero
1 => OneMoreTwiceOf Zero
10 => TwiceOf (OneMoreTwiceOf Zero)
11 => OneMoreTwiceOf (OneMoreTwiceOf Zero)
*)

Fixpoint bin_to_nat (b : bin) : nat :=
match b with
| Zero => O
| TwiceOf b' => 2 * (bin_to_nat b')
| OneMoreTwiceOf b' => 1 + 2 * (bin_to_nat b')
end.

Example test_bin_incr1 : (bin_to_nat Zero) = 0.
Proof. reflexivity. Qed.
Example test_bin_incr2 : (bin_to_nat (incr Zero)) = 1.
Proof. reflexivity. Qed.
Example test_bin_incr3 : (bin_to_nat (incr (incr Zero))) = 2.
Proof. reflexivity. Qed.
Example test_bin_incr4 : (bin_to_nat (incr (incr (incr Zero)))) = 3.
Proof. reflexivity. Qed.
Example test_bin_incr5 : (bin_to_nat (incr (incr (incr (incr Zero))))) = 4.
Proof. reflexivity. 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 (z : natural) (y : natural) (lf1 : natural) : natural :=
  plus lf1 (mult z y).


Require Import Arith.
Require Import Omega.

Print nat_rect.

Definition mod3_rect:=
  fun (P:nat -> Type)
      (f0:P 0)
      (f1:P 1)
      (f2:P 2)
      (fk:forall k,P k -> P (S (S (S k)))) =>
    fix F (n:nat) :P n:=
       match n as i return (P i) with
         | 0 => f0
         | 1 => f1
         | 2 => f2
         | (S (S (S i))) => fk i (F i)
       end.

Definition mod3_ind:=
  fun (P:nat -> Prop)=> mod3_rect P.

Fixpoint mod3 n:=
  match n with
    | S (S (S k)) => mod3 k
    | _ => n
  end.

Definition pow2 (n:nat):= n*n.

Lemma mod3_lt_3:
  forall n,mod3 n < 3.
Proof.
  induction n using mod3_ind;simpl;omega.
Qed.

Lemma mod3_dec:
  forall n,{mod3 n = 0} + {mod3 n = 1} + {mod3 n = 2}.
Proof.
  intros n.
  induction n using mod3_rect.
  - left;left;reflexivity.
  - left;right;reflexivity.
  - right;reflexivity.
  - simpl.
    exact IHn.
Qed.

Lemma mod3_exists:
  forall m n,mod3 m = n -> exists k,m = 3 * k + n.
Proof.
  intros m.
  induction m using mod3_ind;simpl;
  intros n H;try (rewrite <-H; exists 0;simpl;omega).
  cut (mod3 m = n).
  intros H'.
  apply IHm in H.
  destruct H as [k H].
  exists (S k).
  omega.
  exact H.
Qed.

Lemma mod3_mult3:
  forall m n,mod3 (3 * m + n) = mod3 n.
Proof.
  intros m.
  induction m.
  - intros;reflexivity.
  - intros n.
    replace (3 * S m + n) with (3 + (3 * m + n)).
    change (mod3 (3 + (3 * m + n))) with
      (mod3 (3 * m + n)).
    apply IHm.
    ring.
Qed.

Lemma mod3_eq:
  forall m n,m = n -> mod3 m = mod3 n.
Proof.
  intros m n.
  case (mod3_dec m) as [[Hm|Hm]|Hm];
  case (mod3_dec n) as [[Hn|Hn]|Hn];
  apply mod3_exists in Hm;destruct Hm as [m' Hm];
  apply mod3_exists in Hn;destruct Hn as [n' Hn];
  subst m;subst n ;repeat rewrite mod3_mult3;simpl;omega.
Qed.

Lemma mod3_distr:
  forall m n,mod3 (m + n) = mod3 ((mod3 m)+ (mod3 n)).
Proof.
  intros m n.
  assert (forall r s t u v,
            (r*s + u) + (r*t+v) =
               r*(s+t) + (u+v)) as P.
  intros;ring.

  case (mod3_dec m) as [[Hm |Hm]|Hm];
  case (mod3_dec n) as [[Hn |Hn]|Hn];
  rewrite Hm;rewrite Hn;
  apply mod3_exists in Hm;destruct Hm as [m' Hm];
  apply mod3_exists in Hn;destruct Hn as [n' Hn];
  rewrite Hm;rewrite Hn;rewrite P;apply mod3_mult3.
Qed.

Lemma square_expand :
  forall n m,pow2 (3 * m + n) = (3 * (3 * m * m + 2*m*n) + n*n).
Proof.
  intros;unfold pow2;ring.
Qed.

Lemma mod3_sq:
  forall a,mod3 (pow2 a) = 0 -> mod3 a = 0.
Proof.
  intros a.
  case (mod3_dec a)  as [[H|H]|H];
  apply mod3_exists in H;destruct H as [t H];
  subst a;
  rewrite square_expand;
  repeat rewrite mod3_mult3;
  simpl;omega.
Qed.

Lemma square_plus_expand :
  forall n m s t,
    pow2 (3 * m + s) + pow2 (3*n+t) =
    3 * (3 * (m * m + n*n) + 2*(m*s +n*t)) + (s*s + t*t).
Proof.
  intros;unfold pow2;ring.
Qed.

Lemma Quest2_sub:
   forall a b,mod3 (pow2 a + pow2 b) = 0 -> mod3 a = 0/\mod3 b = 0 .
Proof.
  intros a b.
  case (mod3_dec a) as [[Ha|Ha]|Ha];
  case (mod3_dec b) as [[Hb|Hb]|Hb];
  apply mod3_exists in Ha;destruct Ha as [a' Ha];
  apply mod3_exists in Hb;destruct Hb as [b' Hb];
  subst a;subst b;rewrite square_plus_expand;
  repeat rewrite mod3_mult3;
  simpl;omega.
Qed.

Theorem Quest2:
  forall a b c,pow2 a + pow2 b = 3 * pow2 c -> mod3 a = 0/\mod3 b = 0 /\ mod3 c=0.
Proof.
  intros a b c H.
  cut (mod3 a =0/\mod3 b = 0).
  intros P.
  destruct P as [Pa Pb].
  split.
  exact Pa.
  split.
  exact Pb.
  apply mod3_exists in Pa;destruct Pa as [a' Pa].
  apply mod3_exists in Pb;destruct Pb as [b' Pb].
  rewrite plus_0_r in Pa.
  rewrite plus_0_r in Pb.
  subst a;subst b.
  replace (pow2 (3 * a') + pow2 (3 * b')) with
  (3 * (3 * (a'*a' + b'*b') + 0)) in H.
  rewrite NPeano.Nat.mul_cancel_l in H.
  symmetry in H.
  apply mod3_eq in H.
  rewrite mod3_mult3 in H.
  simpl in H.
  apply mod3_sq in H.
  exact H.
  omega.
  unfold pow2.
  ring.
  apply Quest2_sub.
  rewrite H.
  replace (3*pow2 c) with (3*pow2 c + 0).
  rewrite mod3_mult3.
  reflexivity.
  ring.
Qed.

Lemma plus_eq_0:
  forall m n:nat,m+n=0 -> m=0/\n=0.
Proof.
  intros ;omega.
Qed.

Lemma sq_eq_0:
  forall m,m*m = 0 -> m=0.
Proof.
  intros m.
  destruct m.
  omega.
  simpl.
  intros H.
  inversion H.
Qed.

Theorem Quest3:
  forall a b c,pow2 a + pow2 b = 3 * pow2 c -> a = 0/\b = 0 /\ c=0.
Proof.
  intros a b c.
  generalize dependent b.
  generalize dependent a.

  apply lt_wf_ind with (n:=c).
  intros n P a b.
  destruct n as [|n].
  simpl.
  intros H.
  apply plus_eq_0 in H.
  destruct H as [Ha Hb].
  apply sq_eq_0 in Ha.
  apply sq_eq_0 in Hb.
  omega.
  remember (S n) as k.
  intros H.
  cut (mod3 a = 0/\mod3 b = 0 /\ mod3 k=0).
  intros Hm.
  destruct Hm as [Ha [Hb Hk]].
  apply mod3_exists in Ha;destruct Ha as [a' Ha].
  apply mod3_exists in Hb;destruct Hb as [b' Hb].
  apply mod3_exists in Hk;destruct Hk as [k' Hk].
  rewrite plus_0_r in Ha.
  rewrite plus_0_r in Hb.
  rewrite plus_0_r in Hk.
  subst a;subst b.
  rewrite Hk.
  cut ((a' = 0 /\ b' = 0 /\ k' = 0)->
       (3 * a' = 0 /\ 3 * b' = 0 /\ 3 * k' = 0)).
  intros T.
  apply T.
  apply P.
  omega.
  rewrite Hk in H.
  replace (pow2 (3 * a') + pow2 (3 * b'))
    with (9 * ( pow2 a' + pow2 b')) in H.
  replace (3 * pow2 (3 * k'))
    with (9 * (3 * ( pow2 k'))) in H.
  apply NPeano.Nat.mul_cancel_l in H.
  exact H.
  omega.
  unfold pow2;ring.
  unfold pow2;ring.
  intros;omega.
  apply Quest2 in H.
  exact H.
Qed.


(** * IndPrinciples: Induction Principles *)

(** With the Curry-Howard correspondence and its realization in Coq in
    mind, we can now take a deeper look at induction principles. *)

Set Warnings "-notation-overridden,-parsing,-deprecated-hint-without-locality".
From LF Require Export ProofObjects.

(* ################################################################# *)
(** * Basics *)

(** Every time we declare a new [Inductive] datatype, Coq
    automatically generates an _induction principle_ for this type.
    This induction principle is a theorem like any other: If [t] is
    defined inductively, the corresponding induction principle is
    called [t_ind].  Here is the one for natural numbers: *)

Check nat_ind :
  forall P : nat -> Prop,
    P 0 ->
    (forall n : nat, P n -> P (S n)) ->
    forall n : nat, P n.

(** In English: Suppose [P] is a property of natural numbers (that is,
      [P n] is a [Prop] for every [n]). To show that [P n] holds of all
      [n], it suffices to show:

      - [P] holds of [0]
      - for any [n], if [P] holds of [n], then [P] holds of [S n]. *)

(** The [induction] tactic is a straightforward wrapper that, at its
    core, simply performs [apply t_ind].  To see this more clearly,
    let's experiment with directly using [apply nat_ind], instead of
    the [induction] tactic, to carry out some proofs.  Here, for
    example, is an alternate proof of a theorem that we saw in the
    [Induction] chapter. *)

Theorem mul_0_r' : forall n:nat,
  n * 0 = 0.
Proof.
  apply nat_ind.
  - (* n = O *) reflexivity.
  - (* n = S n' *) simpl. intros n' IHn'. rewrite -> IHn'.
    reflexivity.  Qed.

(** This proof is basically the same as the earlier one, but a
    few minor differences are worth noting.

    First, in the induction step of the proof (the [S] case), we
    have to do a little bookkeeping manually (the [intros]) that
    [induction] does automatically.

    Second, we do not introduce [n] into the context before applying
    [nat_ind] -- the conclusion of [nat_ind] is a quantified formula,
    and [apply] needs this conclusion to exactly match the shape of
    the goal state, including the quantifier.  By contrast, the
    [induction] tactic works either with a variable in the context or
    a quantified variable in the goal.

    Third, we had to manually supply the name of the induction principle
    with [apply], but [induction] figures that out itself.

    These conveniences make [induction] nicer to use in practice than
    applying induction principles like [nat_ind] directly.  But it is
    important to realize that, modulo these bits of bookkeeping,
    applying [nat_ind] is what we are really doing. *)

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

    Complete this proof without using the [induction] tactic. *)

Theorem plus_one_r' : forall n:nat,
  n + 1 = S n.
Proof.
  apply nat_ind.
  - reflexivity.
  - intros. simpl. auto.
Qed.
(** [] *)

(** Coq generates induction principles for every datatype
    defined with [Inductive], including those that aren't recursive.
    Although of course we don't need the proof technique of induction
    to prove properties of non-recursive datatypes, the idea of an
    induction principle still makes sense for them: it gives a way to
    prove that a property holds for all values of the type. *)

(** These generated principles follow a similar pattern. If we
    define a type [t] with constructors [c1] ... [cn], Coq generates a
    theorem with this shape:

    t_ind : forall P : t -> Prop,
              ... case for c1 ... ->
              ... case for c2 ... -> ...
              ... case for cn ... ->
              forall n : t, P n

    The specific shape of each case depends on the arguments to the
    corresponding constructor. *)

(** Before trying to write down a general rule, let's look at
    some more examples. First, an example where the constructors take
    no arguments: *)

Inductive time : Type :=
  | day
  | night.

Check time_ind :
  forall P : time -> Prop,
    P day ->
    P night ->
    forall t : time, P t.

(** **** Exercise: 1 star, standard, optional (rgb)

    Write out the induction principle that Coq will generate for the
    following datatype.  Write down your answer on paper or type it
    into a comment, and then compare it with what Coq prints. *)

Inductive rgb : Type :=
  | red
  | green
  | blue.
Check rgb_ind.
(** [] *)

(** Here's another example, this time with one of the constructors
    taking some arguments. *)

Inductive natlist : Type :=
  | nnil
  | ncons (n : nat) (l : natlist).

Check natlist_ind :
  forall P : natlist -> Prop,
    P nnil  ->
    (forall (n : nat) (l : natlist),
        P l -> P (ncons n l)) ->
    forall l : natlist, P l.

(** In general, the automatically generated induction principle for
    inductive type [t] is formed as follows:

    - Each constructor [c] generates one case of the principle.
    - If [c] takes no arguments, that case is:

      "P holds of c"

    - If [c] takes arguments [x1:a1] ... [xn:an], that case is:

      "For all x1:a1 ... xn:an,
          if [P] holds of each of the arguments of type [t],
          then [P] holds of [c x1 ... xn]"

      But that oversimplifies a little.  An assumption about [P]
      holding of an argument [x] of type [t] actually occurs
      immediately after the quantification of [x].
*)

(** For example, suppose we had written the definition of [natlist] a little
    differently: *)

Inductive natlist' : Type :=
  | nnil'
  | nsnoc (l : natlist') (n : nat).

(** Now the induction principle case for [nsnoc1] is a bit different
    than the earlier case for [ncons]: *)

Check natlist'_ind :
  forall P : natlist' -> Prop,
    P nnil' ->
    (forall l : natlist', P l -> forall n : nat, P (nsnoc l n)) ->
    forall n : natlist', P n.

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

    In the comment below, write out the induction principle that Coq
    will generate for the following datatype. *)

Inductive booltree : Type :=
  | bt_empty
  | bt_leaf (b : bool)
  | bt_branch (b : bool) (t1 t2 : booltree).

Check booltree_ind.
(*
forall P : booltree -> Prop,
  (P bt_empty) ->
  (forall b : bool, P (bt_leaf b)) ->
  (forall (b : bool) (t1 t2 : booltree), P t1 -> P t2 -> P (bt_branch b t1 t2)) ->
  forall t : booltree, P t
   ... *)

(* Do not modify the following line: *)
Definition manual_grade_for_booltree_ind : option (nat*string) := None.
(** [] *)

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

    Here is an induction principle for a toy type:

  forall P : Toy -> Prop,
    (forall b : bool, P (con1 b)) ->
    (forall (n : nat) (t : Toy), P t -> P (con2 n t)) ->
    forall t : Toy, P t

    Give an [Inductive] definition of [Toy], such that the induction
    principle Coq generates is that given above: *)

Inductive Toy : Type :=
  | con1 (b : bool)
  | con2 (n : nat) (t : Toy).
  (* FILL IN HERE *)

Check Toy_ind.
(* Do not modify the following line: *)
Definition manual_grade_for_toy_ind : option (nat*string) := None.
(** [] *)

(* ################################################################# *)
(** * Polymorphism *)

(** What about polymorphic datatypes?

    The inductive definition of polymorphic lists

      Inductive list (X:Type) : Type :=
        | nil : list X
        | cons : X -> list X -> list X.

    is very similar to that of [natlist].  The main difference is
    that, here, the whole definition is _parameterized_ on a set [X]:
    that is, we are defining a _family_ of inductive types [list X],
    one for each [X].  (Note that, wherever [list] appears in the body
    of the declaration, it is always applied to the parameter [X].)
*)

(**  The induction principle is likewise parameterized on [X]:

      list_ind :
        forall (X : Type) (P : list X -> Prop),
           P [] ->
           (forall (x : X) (l : list X), P l -> P (x :: l)) ->
           forall l : list X, P l

    Note that the _whole_ induction principle is parameterized on
    [X].  That is, [list_ind] can be thought of as a polymorphic
    function that, when applied to a type [X], gives us back an
    induction principle specialized to the type [list X]. *)

(** **** Exercise: 1 star, standard, optional (tree)

    Write out the induction principle that Coq will generate for
   the following datatype.  Compare your answer with what Coq
   prints. *)

Inductive tree (X:Type) : Type :=
  | leaf (x : X)
  | node (t1 t2 : tree X).
Check tree_ind.
(** [] *)

(** **** Exercise: 1 star, standard, optional (mytype)

    Find an inductive definition that gives rise to the
    following induction principle:

      mytype_ind :
        forall (X : Type) (P : mytype X -> Prop),
            (forall x : X, P (constr1 X x)) ->
            (forall n : nat, P (constr2 X n)) ->
            (forall m : mytype X, P m ->
               forall n : nat, P (constr3 X m n)) ->
            forall m : mytype X, P m
*)
(** [] *)

(** **** Exercise: 1 star, standard, optional (foo)

    Find an inductive definition that gives rise to the
    following induction principle:

      foo_ind :
        forall (X Y : Type) (P : foo X Y -> Prop),
             (forall x : X, P (bar X Y x)) ->
             (forall y : Y, P (baz X Y y)) ->
             (forall f1 : nat -> foo X Y,
               (forall n : nat, P (f1 n)) -> P (quux X Y f1)) ->
             forall f2 : foo X Y, P f2
*)
(** [] *)
Inductive foo (X Y:Type) : Type :=
| bar (x : X)
| baz (y : Y)
| quux (f1 : forall n:nat, foo X Y).

Check foo_ind.

(** **** Exercise: 1 star, standard, optional (foo')

    Consider the following inductive definition: *)

Inductive foo' (X:Type) : Type :=
  | C1 (l : list X) (f : foo' X)
  | C2.

Check foo'_ind.
(** What induction principle will Coq generate for [foo']?  (Fill
   in the blanks, then check your answer with Coq.)

     foo'_ind :
        forall (X : Type) (P : foo' X -> Prop),
              (forall (l : list X) (f : foo' X),
                    P f -> P (C1 X l f)) ->
                    P (C2 X) ->
             forall f : foo' X, P f
*)

(** [] *)

(* ################################################################# *)
(** * Induction Hypotheses *)

(** Where does the phrase "induction hypothesis" fit into this story?

    The induction principle for numbers

       forall P : nat -> Prop,
            P 0  ->
            (forall n : nat, P n -> P (S n))  ->
            forall n : nat, P n

   is a generic statement that holds for all propositions
   [P] (or rather, strictly speaking, for all families of
   propositions [P] indexed by a number [n]).  Each time we
   use this principle, we are choosing [P] to be a particular
   expression of type [nat -> Prop].

   We can make proofs by induction more explicit by giving
   this expression a name.  For example, instead of stating
   the theorem [mul_0_r] as "[forall n, n * 0 = 0]," we can
   write it as "[forall n, P_m0r n]", where [P_m0r] is defined
   as... *)

Definition P_m0r (n:nat) : Prop :=
  n * 0 = 0.

(** ... or equivalently: *)

Definition P_m0r' : nat -> Prop :=
  fun n => n * 0 = 0.

(** Now it is easier to see where [P_m0r] appears in the proof. *)

Theorem mul_0_r'' : forall n:nat,
  P_m0r n.
Proof.
  apply nat_ind.
  - (* n = O *) reflexivity.
  - (* n = S n' *)
    (* Note the proof state at this point! *)
    intros n IHn.
    unfold P_m0r in IHn. unfold P_m0r. simpl. apply IHn. Qed.

(** This extra naming step isn't something that we do in
    normal proofs, but it is useful to do it explicitly for an example
    or two, because it allows us to see exactly what the induction
    hypothesis is.  If we prove [forall n, P_m0r n] by induction on
    [n] (using either [induction] or [apply nat_ind]), we see that the
    first subgoal requires us to prove [P_m0r 0] ("[P] holds for
    zero"), while the second subgoal requires us to prove [forall n',
    P_m0r n' -> P_m0r (S n')] (that is "[P] holds of [S n'] if it
    holds of [n']" or, more elegantly, "[P] is preserved by [S]").
    The _induction hypothesis_ is the premise of this latter
    implication -- the assumption that [P] holds of [n'], which we are
    allowed to use in proving that [P] holds for [S n']. *)

(* ################################################################# *)
(** * More on the [induction] Tactic *)

(** The [induction] tactic actually does even more low-level
    bookkeeping for us than we discussed above.

    Recall the informal statement of the induction principle for
    natural numbers:
      - If [P n] is some proposition involving a natural number n, and
        we want to show that P holds for _all_ numbers n, we can
        reason like this:
          - show that [P O] holds
          - show that, if [P n'] holds, then so does [P (S n')]
          - conclude that [P n] holds for all n.
    So, when we begin a proof with [intros n] and then [induction n],
    we are first telling Coq to consider a _particular_ [n] (by
    introducing it into the context) and then telling it to prove
    something about _all_ numbers (by using induction).
*)

(**  What Coq actually does in this situation, internally, is it
    "re-generalizes" the variable we perform induction on.  For
    example, in our original proof that [plus] is associative... *)

Theorem add_assoc' : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof.
  (* ...we first introduce all 3 variables into the context,
     which amounts to saying "Consider an arbitrary [n], [m], and
     [p]..." *)
  intros n m p.
  (* ...We now use the [induction] tactic to prove [P n] (that
     is, [n + (m + p) = (n + m) + p]) for _all_ [n],
     and hence also for the particular [n] that is in the context
     at the moment. *)
  induction n as [| n'].
  - (* n = O *) reflexivity.
  - (* n = S n' *)
    simpl. rewrite -> IHn'. reflexivity.  Qed.

(** It also works to apply [induction] to a variable that is
    quantified in the goal. *)

Theorem add_comm' : forall n m : nat,
  n + m = m + n.
Proof.
  induction n as [| n'].
  - (* n = O *) intros m. rewrite -> add_0_r. reflexivity.
  - (* n = S n' *) intros m. simpl. rewrite -> IHn'.
    rewrite <- plus_n_Sm. reflexivity.  Qed.

(** Note that [induction n] leaves [m] still bound in the goal --
    i.e., what we are proving inductively is a statement beginning
    with [forall m].

    If we do [induction] on a variable that is quantified in the goal
    _after_ some other quantifiers, the [induction] tactic will
    automatically introduce the variables bound by these quantifiers
    into the context. *)

Theorem add_comm'' : forall n m : nat,
  n + m = m + n.
Proof.
  (* Let's do induction on [m] this time, instead of [n]... *)
  induction m as [| m']. (* [n] is already introduced into the context *)
  - (* m = O *) simpl. rewrite -> add_0_r. reflexivity.
  - (* m = S m' *) simpl. rewrite <- IHm'.
    rewrite <- plus_n_Sm. reflexivity.
Qed.

Theorem add_comm3 : forall n m : nat,
  n + m = m + n.
Proof.
  intros.
  generalize dependent n.
  induction m as [ | m']; intros.
  - (* m = O *) simpl. rewrite -> add_0_r. reflexivity.
  - (* m = S m' *) simpl. rewrite <- IHm'.
    rewrite <- plus_n_Sm. reflexivity.
Qed.

(** **** Exercise: 1 star, standard, optional (plus_explicit_prop)

    Rewrite both [add_assoc'] and [add_comm'] and their proofs in
    the same style as [mul_0_r''] above -- that is, for each theorem,
    give an explicit [Definition] of the proposition being proved by
    induction, and state the theorem and proof in terms of this
    defined proposition.  *)

Check nat_ind.

Definition P_add_assoc : nat -> Prop :=
  fun n => (forall m p, n + (m + p) = (n + m) + p).

Theorem add_assoc'' : forall n : nat,
 P_add_assoc n.
Proof.
  apply nat_ind; unfold P_add_assoc; intros.
  - reflexivity.
  - simpl. rewrite (H m p). reflexivity.
Qed.

Definition P_add_comm : nat -> Prop :=
  fun n => (forall m, n + m = m + n).

Theorem add_comm4 : forall n, P_add_comm n.
Proof.
  apply nat_ind; unfold P_add_comm; simpl; intros.
  - rewrite add_0_r. reflexivity.
  - rewrite (H m). rewrite <- plus_n_Sm. reflexivity.
Qed.

(* ################################################################# *)
(** * Induction Principles for Propositions *)

(** Inductive definitions of propositions also cause Coq to generate
    induction priniciples.  For example, recall our proposition [ev]
    from [IndProp]: *)

Print ev.

(* ===>

  Inductive ev : nat -> Prop :=
  | ev_0 : ev 0
  | ev_SS : forall n : nat, ev n -> ev (S (S n)))

*)

Check ev_ind :
  forall P : nat -> Prop,
    P 0 ->
    (forall n : nat, ev n -> P n -> P (S (S n))) ->
    forall n : nat, ev n -> P n.

(** In English, [ev_ind] says: Suppose [P] is a property of natural
    numbers.  To show that [P n] holds whenever [n] is even, it suffices
    to show:

      - [P] holds for [0],

      - for any [n], if [n] is even and [P] holds for [n], then [P]
        holds for [S (S n)]. *)

(** As expected, we can apply [ev_ind] directly instead of using
    [induction].  For example, we can use it to show that [ev'] (the
    slightly awkward alternate definition of evenness that we saw in
    an exercise in the [IndProp] chapter) is equivalent to the
    cleaner inductive definition [ev]: *)

Inductive ev' : nat -> Prop :=
  | ev'_0 : ev' 0
  | ev'_2 : ev' 2
  | ev'_sum n m (Hn : ev' n) (Hm : ev' m) : ev' (n + m).

Theorem ev_ev' : forall n, ev n -> ev' n.
Proof.
  apply ev_ind.
  - (* ev_0 *)
    apply ev'_0.
  - (* ev_SS *)
    intros m Hm IH.
    apply (ev'_sum 2 m).
    + apply ev'_2.
    + apply IH.
Qed.

(** The precise form of an [Inductive] definition can affect the
    induction principle Coq generates. *)

Inductive le1 : nat -> nat -> Prop :=
  | le1_n : forall n, le1 n n
  | le1_S : forall n m, (le1 n m) -> (le1 n (S m)).

Notation "m <=1 n" := (le1 m n) (at level 70).

(** This definition can be streamlined a little by observing that the
    left-hand argument [n] is the same everywhere in the definition,
    so we can actually make it a "general parameter" to the whole
    definition, rather than an argument to each constructor. *)

Inductive le2 (n:nat) : nat -> Prop :=
  | le2_n : le2 n n
  | le2_S m (H : le2 n m) : le2 n (S m).

Notation "m <=2 n" := (le2 m n) (at level 70).

(** The second one is better, even though it looks less symmetric.
    Why?  Because it gives us a simpler induction principle. *)

Check le1_ind :
  forall P : nat -> nat -> Prop,
    (forall n : nat, P n n) ->
    (forall n m : nat, n <=1 m -> P n m -> P n (S m)) ->
    forall n n0 : nat, n <=1 n0 -> P n n0.

Check le2_ind :
  forall (n : nat) (P : nat -> Prop),
    P n ->
    (forall m : nat, n <=2 m -> P m -> P (S m)) ->
    forall n0 : nat, n <=2 n0 -> P n0.

(* ################################################################# *)
(** * Another Form of Induction Principles on Propositions (Optional) *)

(** The induction principle that Coq generated for [ev] was parameterized
    on a natural number [n].  It could have additionally been parameterized
    on the evidence that [n] was even, which would have led to this
    induction principle:

    forall P : (forall n : nat, ev'' n -> Prop),
      P O ev_0 ->
      (forall (m : nat) (E : ev'' m),
        P m E -> P (S (S m)) (ev_SS m E)) ->
      forall (n : nat) (E : ev'' n), P n E
*)

(**   ... because:

     - Since [ev] is indexed by a number [n] (every [ev] object [E] is
       a piece of evidence that some particular number [n] is even),
       the proposition [P] is parameterized by both [n] and [E] --
       that is, the induction principle can be used to prove
       assertions involving both an even number and the evidence that
       it is even.

     - Since there are two ways of giving evidence of evenness ([even]
       has two constructors), applying the induction principle
       generates two subgoals:

         - We must prove that [P] holds for [O] and [ev_0].

         - We must prove that, whenever [m] is an even number and [E]
           is an evidence of its evenness, if [P] holds of [m] and
           [E], then it also holds of [S (S m)] and [ev_SS m E].

     - If these subgoals can be proved, then the induction principle
       tells us that [P] is true for _all_ even numbers [n] and
       evidence [E] of their evenness.

    This is more flexibility than we normally need or want: it is
    giving us a way to prove logical assertions where the assertion
    involves properties of some piece of _evidence_ of evenness, while
    all we really care about is proving properties of _numbers_ that
    are even -- we are interested in assertions about numbers, not
    about evidence.  It would therefore be more convenient to have an
    induction principle for proving propositions [P] that are
    parameterized just by [n] and whose conclusion establishes [P] for
    all even numbers [n]:

       forall P : nat -> Prop,
         ... ->
       forall n : nat,
         even n -> P n

    That is why Coq actually generates the induction principle
    [ev_ind] that we saw before. *)

(* ################################################################# *)
(** * Formal vs. Informal Proofs by Induction *)

(** Question: What is the relation between a formal proof of a
    proposition [P] and an informal proof of the same proposition [P]?

    Answer: The latter should _teach_ the reader everything they would
    need to understand to be able to produce the former.

    Question: How much detail does that require?

    Unfortunately, there is no single right answer; rather, there is a
    range of choices.

    At one end of the spectrum, we can essentially give the reader the
    whole formal proof (i.e., the "informal" proof will amount to just
    transcribing the formal one into words).  This may give the reader
    the ability to reproduce the formal one for themselves, but it
    probably doesn't _teach_ them anything much.

   At the other end of the spectrum, we can say "The theorem is true
   and you can figure out why for yourself if you think about it hard
   enough."  This is also not a good teaching strategy, because often
   writing the proof requires one or more significant insights into
   the thing we're proving, and most readers will give up before they
   rediscover all the same insights as we did.

   In the middle is the golden mean -- a proof that includes all of
   the essential insights (saving the reader the hard work that we
   went through to find the proof in the first place) plus high-level
   suggestions for the more routine parts to save the reader from
   spending too much time reconstructing these (e.g., what the IH says
   and what must be shown in each case of an inductive proof), but not
   so much detail that the main ideas are obscured.

   Since we've spent much of this chapter looking "under the hood" at
   formal proofs by induction, now is a good moment to talk a little
   about _informal_ proofs by induction.

   In the real world of mathematical communication, written proofs
   range from extremely longwinded and pedantic to extremely brief and
   telegraphic.  Although the ideal is somewhere in between, while one
   is getting used to the style it is better to start out at the
   pedantic end.  Also, during the learning phase, it is probably
   helpful to have a clear standard to compare against.  With this in
   mind, we offer two templates -- one for proofs by induction over
   _data_ (i.e., where the thing we're doing induction on lives in
   [Type]) and one for proofs by induction over _evidence_ (i.e.,
   where the inductively defined thing lives in [Prop]). *)

(* ================================================================= *)
(** ** Induction Over an Inductively Defined Set *)

(** _Template_:

       - _Theorem_: <Universally quantified proposition of the form
         "For all [n:S], [P(n)]," where [S] is some inductively defined
         set.>

         _Proof_: By induction on [n].

           <one case for each constructor [c] of [S]...>

           - Suppose [n = c a1 ... ak], where <...and here we state
             the IH for each of the [a]'s that has type [S], if any>.
             We must show <...and here we restate [P(c a1 ... ak)]>.

             <go on and prove [P(n)] to finish the case...>

           - <other cases similarly...>                        []

    _Example_:

      - _Theorem_: For all sets [X], lists [l : list X], and numbers
        [n], if [length l = n] then [index (S n) l = None].

        _Proof_: By induction on [l].

        - Suppose [l = []].  We must show, for all numbers [n],
          that, if [length [] = n], then [index (S n) [] =
          None].

          This follows immediately from the definition of [index].

        - Suppose [l = x :: l'] for some [x] and [l'], where
          [length l' = n'] implies [index (S n') l' = None], for
          any number [n'].  We must show, for all [n], that, if
          [length (x::l') = n] then [index (S n) (x::l') =
          None].

          Let [n] be a number with [length l = n].  Since

            length l = length (x::l') = S (length l'),

          it suffices to show that

            index (S (length l')) l' = None.

          But this follows directly from the induction hypothesis,
          picking [n'] to be [length l'].  [] *)

(* ================================================================= *)
(** ** Induction Over an Inductively Defined Proposition *)

(** Since inductively defined proof objects are often called
    "derivation trees," this form of proof is also known as _induction
    on derivations_.

    _Template_:

       - _Theorem_: <Proposition of the form "[Q -> P]," where [Q] is
         some inductively defined proposition (more generally,
         "For all [x] [y] [z], [Q x y z -> P x y z]")>

         _Proof_: By induction on a derivation of [Q].  <Or, more
         generally, "Suppose we are given [x], [y], and [z].  We
         show that [Q x y z] implies [P x y z], by induction on a
         derivation of [Q x y z]"...>

           <one case for each constructor [c] of [Q]...>

           - Suppose the final rule used to show [Q] is [c].  Then
             <...and here we state the types of all of the [a]'s
             together with any equalities that follow from the
             definition of the constructor and the IH for each of
             the [a]'s that has type [Q], if there are any>.  We must
             show <...and here we restate [P]>.

             <go on and prove [P] to finish the case...>

           - <other cases similarly...>                        []

    _Example_

       - _Theorem_: The [<=] relation is transitive -- i.e., for all
         numbers [n], [m], and [o], if [n <= m] and [m <= o], then
         [n <= o].

         _Proof_: By induction on a derivation of [m <= o].

           - Suppose the final rule used to show [m <= o] is
             [le_n]. Then [m = o] and we must show that [n <= m],
             which is immediate by hypothesis.

           - Suppose the final rule used to show [m <= o] is
             [le_S].  Then [o = S o'] for some [o'] with [m <= o'].
             We must show that [n <= S o'].
             By induction hypothesis, [n <= o'].

             But then, by [le_S], [n <= S o'].  [] *)

(* ################################################################# *)
(** * Explicit Proof Objects for Induction (Optional) *)

(** Although tactic-based proofs are normally much easier to
    work with, the ability to write a proof term directly is sometimes
    very handy, particularly when we want Coq to do something slightly
    non-standard.  *)

(** Recall again the induction principle on naturals that Coq generates for
    us automatically from the Inductive declaration for [nat]. *)

Check nat_ind :
  forall P : nat -> Prop,
    P 0 ->
    (forall n : nat, P n -> P (S n)) ->
    forall n : nat, P n.

(** There's nothing magic about this induction lemma: it's just
   another Coq lemma that requires a proof.  Coq generates the proof
   automatically too...  *)

Print nat_ind.

(** We can rewrite that more tidily as follows: *)
Fixpoint build_proof
         (P : nat -> Prop)
         (evPO : P 0)
         (evPS : forall n : nat, P n -> P (S n))
         (n : nat) : P n :=
  match n with
  | 0 => evPO
  | S k => evPS k (build_proof P evPO evPS k)
  end.

Definition nat_ind_tidy := build_proof.

(** We can read [build_proof] as follows: Suppose we have
    evidence [evPO] that [P] holds on 0, and evidence [evPS] that [forall
    n:nat, P n -> P (S n)].  Then we can prove that [P] holds of an
    arbitrary nat [n] using recursive function [build_proof], which
    pattern matches on [n]:

      - If [n] is 0, [build_proof] returns [evPO] to show that [P n]
        holds.

      - If [n] is [S k], [build_proof] applies itself recursively on
        [k] to obtain evidence that [P k] holds; then it applies
        [evPS] on that evidence to show that [P (S n)] holds. *)

(** Recursive function [build_proof] thus pattern matches against
    [n], recursing all the way down to 0, and building up a proof
    as it returns. *)

(** The actual [nat_ind] that Coq generates uses a recursive
    function [F] defined with [fix] instead of [Fixpoint]. *)

(** We can adapt this approach to proving [nat_ind] to help prove
    _non-standard_ induction principles too.  As a motivating example,
    suppose that we want to prove the following lemma, directly
    relating the [ev] predicate we defined in [IndProp]
    to the [even] function defined in [Basics]. *)

Lemma even_ev : forall n: nat, even n = true -> ev n.
Proof.
  induction n; intros.
  - apply ev_0.
  - destruct n.
    + simpl in H. inversion H.
    + simpl in H.
      apply ev_SS.
Abort.

(** Attempts to prove this by standard induction on [n] fail in the case for
    [S (S n)], because the induction hypothesis only tells us something about
    [S n], which is useless. There are various ways to hack around this problem;
    for example, we _can_ use ordinary induction on [n] to prove this (try it!):

    [Lemma even_ev' : forall n : nat,
     (even n = true -> ev n) /\ (even (S n) = true -> ev (S n))].

    But we can make a much better proof by defining and proving a
    non-standard induction principle that goes "by twos":
 *)

Definition nat_ind2 :
  forall (P : nat -> Prop),
  P 0 ->
  P 1 ->
  (forall n : nat, P n -> P (S(S n))) ->
  forall n : nat , P n :=
    fun P => fun P0 => fun P1 => fun PSS =>
      fix f (n:nat) := match n with
                         0 => P0
                       | 1 => P1
                       | S (S n') => PSS n' (f n')
                       end.

 (** Once you get the hang of it, it is entirely straightforward to
     give an explicit proof term for induction principles like this.
     Proving this as a lemma using tactics is much less intuitive.

     The [induction ... using] tactic variant gives a convenient way to
     utilize a non-standard induction principle like this. *)

Lemma even_ev : forall n, even n = true -> ev n.
Proof.
  intros.
  induction n as [ | |n'] using nat_ind2.
  - apply ev_0.
  - simpl in H.
    inversion H.
  - simpl in H.
    apply ev_SS.
    apply IHn'.
    apply H.
Qed.

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


(** 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 (z : natural) (y : natural) (x : natural) : natural :=
  mult y (mult (Succ x) z).