Set Warnings "-notation-overridden,-parsing".
Require Import Tactics.
Require Import Poly.
Require Import Nat.
Require Import Arith.
Require Import Induction.

From Coq Require Import Setoids.Setoid.

Lemma and_intro: forall A B: Prop, A->B->A/\B.
Proof.
  intros A B HA HB.
  split.
  apply HA.
  apply HB.
Qed.

Example and_exercise:
  forall n m: nat, n + m = 0 -> n = 0 /\ m = 0.
Proof.
  intros n m H.
  destruct n as [|n'] eqn: En.
  - simpl in H. split.
    * reflexivity.
    * apply H.
  - discriminate H.
Qed.

Lemma and_example2:
  forall n m: nat, n = 0 /\ m = 0 -> n + m = 0.
Proof.
  intros n m H.
  destruct H as [Hn Hm] eqn: HE.
  rewrite Hn. apply Hm.
Qed.

Lemma proj1: forall P Q: Prop, P /\ Q -> P.
Proof.
  intros P Q [PH _].
  apply PH.
Qed.

Lemma proj2: forall P Q: Prop, P /\ Q -> Q.
Proof.
  intros P Q [_ QH].
  apply QH.
Qed.

Theorem and_assoc: forall P Q R: Prop,
  P /\ (Q /\ R) -> (P /\ Q) /\ R.
Proof.
  intros P Q R [HP [HQ HR]].
  split. split.
  apply HP. apply HQ. apply HR.
Qed.

Lemma or_intro_l: forall a b: Prop, a-> a \/ b.
Proof.
  intros a b H.
  left. apply H.
Qed.

Lemma zero_or_succ: forall n: nat, n = 0 \/ n = S (pred n).
Proof.
  intros [|n'].
  - left. reflexivity.
  - right. reflexivity.
Qed.

Check not.

Theorem ex_falso_quodlibet: forall p: Prop, False -> p.
Proof.
  intros p contra.
  destruct contra.
Qed.

Fact not_implies_our_not: forall P: Prop, ~P -> (forall Q:Prop, P->Q).
Proof.
  intros P H1 Q H2.
  apply H1 in H2.
  destruct H2.
Qed.

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

Theorem contradiction_implies_anything: forall P Q: Prop, (P/\~P) -> Q.
Proof.
  intros P Q [H1 H2].
  apply H2 in H1.
  destruct H1.
Qed.

Theorem double_neg: forall P: Prop, P -> ~~P.
Proof.
  intros P H.
  unfold not.
  intros H1.
  apply H1 in H.
  apply H.
Qed.

Theorem contraposite: forall (p q: Prop), (p->q)->(~q->~p).
Proof.
  intros p q H.
  unfold not. intros H1.
  intros H2.
  apply H in H2.
  apply H1 in H2.
  apply H2.
Qed.

Theorem not_both_true_and_false: forall p: Prop, ~(p /\ ~p).
Proof.
  intros p.
  unfold not.
  intros H.
  destruct H as [H1 H2].
  apply H2 in H1.
  apply H1.
Qed.

Theorem not_true_is_false: forall b: bool,
  b <> true -> b = false.
Proof.
  intros b H.
  destruct b eqn: E.
  - exfalso. apply H. reflexivity.
  - reflexivity.
Qed.

Lemma True_is_true: True.
Proof. apply I. Qed.

Theorem iff_sym: forall p q: Prop, (p<->q) -> (q<->p).
Proof.
  intros P Q [H1 H2].
  split.
  - apply H2.
  - apply H1.
Qed.

Lemma not_true_iff_false: forall b, b<>true <-> b = false.
Proof.
  intros b.
  split.
  - apply not_true_is_false.
  - intros H. unfold not. rewrite H. intros H1. discriminate H1.
Qed.

Theorem  or_distributes_over_and: forall p q r: Prop, p\/(q/\r) <-> (p\/q)/\(p\/r).
Proof.
  intros p q r.
  split.
  - intros [HP|[HQ HR]].
    + split.
      * left. apply HP.
      * left. apply HP.
    + split.
      * right. apply HQ.
      * right. apply HR.
  - intros [[HP1|HQ] [HP2|HR]].
    * left. apply HP1.
    * left. apply HP1.
    * left. apply HP2.
    * right. split.
      { apply HQ. }
      { apply HR. }
Qed.

Check mult_comm.

Lemma mult_0 : forall n m, n * m = 0 <-> n = 0\/ m = 0.
Proof.
  split.
  - intros H. destruct n as [|n'] eqn: E.
    + left. reflexivity.
    + simpl in H. right. destruct m as [|m'] eqn:E1.
      * reflexivity.
      * simpl in H. discriminate H.
  - intros H. destruct H as [H|H].
    + rewrite H. reflexivity.
    + rewrite H. apply mult_comm.
Qed.

Lemma or_assoc:
  forall p q r: Prop, p \/ (q\/r) <-> (p\/q)\/r.
Proof.
  intros p q r. split.
  - intros [H | [H | H]].
    + left. left. apply H.
    + left. right. apply H.
    + right. apply H.
  - intros [[H | H] | H].
    + left. apply H.
    + right. left. apply H.
    + right. right. apply H.
Qed.

Lemma mult_0_3: forall n m p, n * m * p = 0 <-> n = 0 \/ m = 0 \/ p = 0.
Proof.
  intros n m p.
  rewrite mult_0. rewrite mult_0. rewrite or_assoc.
  reflexivity.
Qed.

Lemma apply_iff_example:
  forall n m: nat, n * m = 0 -> n=0 \/ m = 0.
Proof.
  intros n m H.
  apply mult_0.
  apply H.
Qed.

Theorem dist_not_exists: forall (X: Type) (P: X->Prop),
  (forall x, P x) -> ~(exists x, ~P x).
Proof.
  intros X P H.
  unfold not.
  intros H1.
  destruct H1 as [x E].
  apply E. apply H.
Qed.

Theorem dist_exists_or: forall (X: Type) (p q: X->Prop),
  (exists x, p x \/ q x) <-> (exists x, p x) \/ (exists x, q x).
Proof.
  intros X p q.
  split.
  - intros [x' H]. destruct H as [H|H].
    * left. exists x'. apply H.
    * right. exists x'. apply H.
  - intros [[x' H]|[x' H]].
    * exists x'. left. apply H.
    * exists x'. right. apply H.
Qed.

Fixpoint In {X: Type} (x: X) (l: list X): Prop :=
  match l with
  | nil => False
  | h::t => x = h \/ In x t
  end.

Lemma In_map: forall (A B: Type) (f: A->B) (l: list A) (x: A),
  In x l -> In (f x) (map f l).
Proof.
  intros A B f l x.
  induction l as [|h t H].
  - intros H1. simpl. unfold In in H1. apply H1.
  - simpl.
    intros H1.
    destruct H1 as [H1|H1].
    * left. rewrite H1. reflexivity.
    * apply H in H1.
      right. apply H1.
Qed.

Lemma In_map_iff:
  forall (A B: Type) (f: A->B) (l: list A) (y: B),
    In y (map f l) <-> exists x, f x = y /\ In x l.
Proof.
  intros A B f l y. split.
  - induction l as [|h t H].
    * simpl. intros H'. destruct H'.
    * simpl. intros H'. destruct H' as [H'|H'].
      + exists h. split.
        { rewrite H'. reflexivity. }
        { left. reflexivity. }
      + apply H in H'.
        destruct H' as [x' H'].
        exists x'.
        destruct H' as [H'1 H'2].
        split.
        { apply H'1. }
        { right. apply H'2. }
  - intros [x' H].
    induction l as [|h t iH].
    * destruct H as [H1 H2].
      simpl in H2.
      destruct H2.
    * simpl. destruct H as [H1 H2].
      simpl in H2.
      destruct H2 as [H2 | H2].
      + rewrite H2 in H1.
        left. symmetry. apply H1.
      + right. apply iH. split.
        { apply H1. }
        { apply H2. }
Qed.

Lemma In_app_iff: forall A l1 l2 (a: A),
  In a (l1 ++ l2) <-> In a l1 \/ In a l2.
Proof.
  split.
  - intros H. induction l1 as [|h t iH].
    + right. simpl in H. apply H.
    + simpl in H. destruct H as [H | H].
      * left. rewrite H. simpl. left. reflexivity.
      * simpl. apply or_assoc. right.
        apply iH. apply H.
  - intros H. destruct H as [H | H].
    + induction l1 as [|h t iH].
      * destruct H.
      * simpl. simpl in H. destruct H as [H|H].
        { left. apply H. }
        { right. apply iH. apply H. }
    + induction l1 as [|h t iH].
      * apply H.
      * simpl. right.  apply iH.
Qed.

Fixpoint All {T: Type} (P: T->Prop) (l: list T): Prop :=
  match l with
  | [] => True
  | h::t => P h /\ All P t
  end.

Lemma All_In:
  forall T (P: T->Prop) (l: list T),
    (forall x, In x l -> P x) <-> All P l.
Proof.
  split.
  - intros H.
    induction l as [|h t iH].
    + reflexivity.
    + simpl. simpl in H.
      split.
      * apply H. left. reflexivity.
      * apply iH. intros x H'. apply H. right. apply H'.
  - intros H.
    induction l as [|h t iH].
    + intros x H'. destruct H'.
    + simpl. intros x H'. destruct H' as [H' | H'].
      * simpl in H. destruct H as [H0 H1]. rewrite <- H' in H0. apply H0.
      * simpl in H. destruct H as [H0 H1].
        specialize (iH H1). apply iH with (x) in H'.
        apply H'.
Qed.

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

Theorem combine_odd_even_intro:
  forall (Podd Peven: nat -> Prop) (n: nat),
    (odd n = true -> Podd n) -> (odd n = false -> Peven n) -> combine_odd_even Podd Peven n.
Proof.
  intros Podd Peven n H1 H2.
  unfold combine_odd_even.
  destruct (odd n) eqn: E.
  - apply H1. reflexivity.
  - apply H2. reflexivity.
Qed.

Theorem combine_odd_even_elim_odd:
  forall (Podd Peven: nat -> Prop) (n: nat),
    combine_odd_even Podd Peven n -> odd n = true -> Podd n.
Proof.
  intros Podd Peven n H1 H2.
  unfold combine_odd_even in H1.
  rewrite H2 in H1.
  apply H1.
Qed.

Theorem combine_odd_even_elim_even :
  forall (Podd Peven: nat -> Prop) (n: nat),
    combine_odd_even Podd Peven n -> odd n = false -> Peven n.
Proof.
  intros Podd Peven n H1 H2.
  unfold combine_odd_even in H1.
  rewrite H2 in H1.
  apply H1.
Qed.

Lemma plus_comm3_take3: forall x y z, x + (y + z) = (z + y) + x.
Proof.
  intros x y z.
  rewrite plus_comm.
  rewrite (plus_comm y z).
  reflexivity.
Qed.

Theorem in_not_nil: forall A (x: A) (l: list A), In x l -> l <> [].
Proof.
  intros A x l H.
  unfold not. intro H1. destruct l eqn: E.
  - simpl in H. destruct H.
  - discriminate H1.
Qed.

Example lemma_application_ex:
  forall {n: nat} {ns: list nat}, In n (map (fun m => m * 0) ns) -> n = 0.
Proof.
  intros n ns H.
  destruct (proj1 _ _ (In_map_iff _ _ _ _ _) H) as [m [Hm _]].
  rewrite mult_0_r in Hm. rewrite <- Hm. reflexivity.
Qed.

Fixpoint rev_append {X} (l1 l2: list X) : list X :=
  match l1 with
  | [] => l2
  | x :: xs => rev_append xs (x :: l2)
  end.
Definition tr_rev {X} (l : list X) : list X :=
  rev_append l [].

Axiom functional_extensionlity:
  forall (X Y: Type) {f g: X -> Y}, (forall x: X, f x = g x) -> f = g.

Lemma rev_app: forall X (a b c: list X), rev_append a (b ++ c) = rev_append a b ++ c.
Proof.
  intros X a.
  induction a as [|h t iH].
  - reflexivity.
  - simpl. intros b c.
    rewrite <- iH. apply f_equal.
    induction c as [|hc tc iHc].
    * reflexivity.
    * simpl. reflexivity.
Qed.

Lemma tr_rev_correct: forall X, @tr_rev X = @rev X.
Proof.
  intros X.
  apply functional_extensionlity.
  intros x.
  induction x as [|h t iH].
  - reflexivity.
  - unfold tr_rev . simpl.
    unfold tr_rev in iH.
    rewrite <- iH.
    replace ([h]) with ([] ++ [h]). rewrite rev_app. reflexivity.
    unfold app. reflexivity.
Qed.

Lemma evenb_double: forall k, evenb (double k) = true.
Proof.
  intros k.
  induction k as [|k' iHk].
  - reflexivity.
  - simpl. apply iHk.
Qed.

Lemma evenb_double_conv:
  forall n, exists k, n = if evenb n then double k else S (double k).
Proof.
  intros n.
  induction n as [|n' iHn].
  - simpl. exists 0. reflexivity.
  - destruct (evenb n') eqn: E.
    + rewrite evenb_S. rewrite E. simpl. destruct iHn as [n'' iHn].
      exists n''. f_equal. apply iHn.
    + rewrite evenb_S.  rewrite E. simpl. destruct iHn as [n'' iHn].
      exists (S n'').  rewrite iHn.
      assert (H: forall x, double (S x) = S (S (double x))).
      * destruct x as [|x'].
        { reflexivity. }
        { simpl. reflexivity. }
      * rewrite H. reflexivity.
Qed.

Theorem eqb_true: forall n m, n =? m = true -> n = m.
Proof.
  intros n.
  induction n as [|n' iHn'].
  - intros m H. destruct m as [| m'].
    + reflexivity.
    + discriminate H.
  - intros m H. destruct m as [| m'].
    + discriminate H.
    + apply f_equal.
      apply iHn'.
      apply H.
Qed.

Theorem eqb_eq : forall n1 n2 : nat,
  n1 =? n2 = true <-> n1 = n2.
Proof.
  intros n1 n2. split.
  - apply eqb_true.
  - intros H. rewrite H. rewrite <- eqb_refl. reflexivity.
Qed.

Lemma andb_truee_iff: forall b1 b2: bool,
  andb b1 b2 = true <-> b1 = true /\ b2 = true.
Proof.
  split.
  - intros H.
    destruct b1 eqn: E1.
    + destruct b2 eqn: E2.
      * split.
        { reflexivity. }
        { reflexivity. }
      * discriminate H.
    + destruct b2 eqn: E2.
      * discriminate H.
      * discriminate H.
  - intros [H1 H2].
    rewrite H1. apply H2.
Qed.

Check eqb_refl.

Theorem eqb_neq:
  forall (x y: nat), x =? y = false <-> x<>y.
Proof.
  split.
  - intros H.
    unfold not.
    intros H1.
    rewrite H1 in H.
    rewrite <- eqb_refl in H.
    discriminate H.
  - intros H1.
    unfold not in H1.
    destruct (x=?y) eqn: E.
    + apply eqb_eq in E.
      apply H1 in E.
      destruct E.
    + reflexivity.
Qed.

Fixpoint eqb_list {A: Type} (eqb: A->A->bool) (l1 l2: list A): bool :=
  match l1, l2 with
  | [], [] => true
  | h1::t1, h2::t2 => if eqb h1 h2 then eqb_list eqb t1 t2 else false
  | _, _ => false
  end.

Lemma eqb_list_true_iff:
  forall A (eqb: A->A->bool),
    (forall a1 a2, eqb a1 a2 = true <-> a1=a2) ->
      (forall l1 l2, eqb_list eqb l1 l2 = true <-> l1 = l2).
Proof.
  intros A eqb H.
  induction l1 as [|h t iH1].
  + destruct l2.
    - split.
      * intros _. reflexivity.
      * intros _. reflexivity.
    - split.
      * simpl. intros H'. discriminate H'.
      * simpl. intros H'. discriminate H'.
  + destruct l2.
    - split.
      * simpl. intros H'. discriminate H'.
      * simpl. intros H'. discriminate H'.
    - split.
      * simpl. intros H'. destruct (eqb h x) eqn: E.
        { apply iH1 in H'. rewrite H'. f_equal.
          apply H. apply E. }
        { discriminate H'. }
      * simpl. intros H'. injection H' as H1 H2.
        apply H in H1.  rewrite H1.  apply iH1. apply H2.
Qed.

Fixpoint forallb {X: Type} (test: X->bool) (l: list X): bool :=
  match l with
  | [] => true
  | h::t => andb (test h) (forallb test t)
  end.
Theorem forallb_true_iff: forall X test (l: list X),
  forallb test l = true <-> All (fun x => test x = true) l.
Proof.
  split.
  - intros H.
    induction l as [|h t iH].
    + reflexivity.
    + simpl. simpl in H. destruct (test h) eqn: E.
      * simpl in H. split.
        { reflexivity. }
        { apply iH.  apply H. }
      * discriminate H.
  - intros H.
    induction l as [|h t iH].
    + reflexivity.
    + simpl. simpl in H. destruct H as [H1 H2].
      rewrite H1. simpl. apply iH.  apply H2.
Qed.

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

Definition excluded_middle := forall P : Prop,
  P \/ ~P.

Theorem not_exists_dist:
  excluded_middle ->
  forall (X: Type) (P: X -> Prop),
    ~(exists x, ~P x) -> (forall x, P x).
Proof.
  intros H1 X P H2 x.
  unfold excluded_middle in H1.
  destruct (H1 (P x)) as [H1' | H1''].
  - apply H1'.
  - exfalso. apply H2. exists x. apply H1''.
Qed.

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

Theorem excluded_middle_to_double_negation_elimination: excluded_middle -> double_negation_elimination.
Proof.
  unfold double_negation_elimination.
  unfold excluded_middle.
  intros H P.
  unfold not.
  intros H1.
  destruct (H P) as [H'|H'].
  + apply H'.
  + exfalso. apply H1. apply H'.
Qed.

Theorem double_negation_elimination_to_de_morgan_not_and_not:
  double_negation_elimination -> de_morgan_not_and_not.
Proof.
  unfold de_morgan_not_and_not.
  unfold double_negation_elimination.
  unfold not.
  intros H P Q H1.


(* Definition *)
Fixpoint eqb (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' => eqb 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.

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

Theorem nat_equals_self : forall n : nat, n =? n = true.
Proof.
  intros n. induction n as [| n' IH].
    - reflexivity.
    - simpl. rewrite -> IH. reflexivity.
Qed.

Module NatList.

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

Definition odd (n:nat) : bool :=
  negb (even n).

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

Theorem add_comm : forall n m : nat,
  n + m = m + n.
Proof.
  intros n m. induction n.
  - simpl. rewrite add_0_r. reflexivity.
  - simpl. rewrite IHn. rewrite plus_n_Sm. reflexivity.
Qed.

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

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

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

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

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

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

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

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

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

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

(* Exercise *)
Theorem fst_swap_is_snd : forall (p : natprod),
  fst (swap_pair p) = snd p.
Proof.
  intros p.
  rewrite <- snd_fst_is_swap.
  simpl. reflexivity.
Qed.

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

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

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

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

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

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

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

(* Exercise *)
Fixpoint nonzeros (l:natlist) : natlist :=
  match l with
  | nil => nil
  | 0 :: t => nonzeros t
  | n :: t => n :: nonzeros t
  end.

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

Fixpoint oddmembers (l:natlist) : natlist :=
  match l with
  | nil => nil
  | n :: t => if odd n
                  then n :: oddmembers t
                else
                  oddmembers t
  end.

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

Fixpoint countoddmembers (l:natlist) : nat :=
  match l with
  | nil => 0
  | n :: t => if odd n
                  then 1 + countoddmembers t
                else
                  countoddmembers t
  end.

Example test_countoddmembers1 : countoddmembers [1;0;3;1;4;5] = 4.
Proof. simpl. reflexivity. Qed.
Example test_countoddmembers2 : countoddmembers [0;2;4] = 0.
Proof. simpl. reflexivity. Qed.
Example test_countoddmembers3 : countoddmembers nil = 0.
Proof. simpl. reflexivity. Qed.

(* Exercise *)
Fixpoint alternate (l1 l2 : natlist) : natlist :=
  match l1, l2 with
    | nil, l => l
    | l, nil => l
    | h1 :: t1, h2 :: t2 => h1 :: h2 :: alternate t1 t2
  end.

Example test_alternate1:
  alternate [1;2;3] [4;5;6] = [1;4;2;5;3;6].
Proof. simpl. reflexivity. Qed.
Example test_alternate2:
  alternate [1] [4;5;6] = [1;4;5;6].
Proof. simpl. reflexivity. Qed.
Example test_alternate3:
  alternate [1;2;3] [4] = [1;4;2;3].
Proof. simpl. reflexivity. Qed.
Example test_alternate4:
  alternate [] [20;30] = [20;30].
Proof. simpl. reflexivity. Qed.

(* Definition *)
Definition bag := natlist.

(* Exercise *)
Fixpoint count (v:nat) (s:bag) : nat :=
  match s with
  | nil => 0
  | x :: t => count v t + (if eqb x v then 1 else 0)
  end.

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

Definition sum : bag -> bag -> bag :=
  app.
Example test_sum1: count 1 (sum [1;2;3] [1;4;1]) = 3.
Proof. simpl. reflexivity. Qed.

Definition add (v : nat) (s : bag) : bag :=
  v :: s.

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

Definition member (v : nat) (s : bag) : bool :=
  leb 1 (count v s).

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

(* Exercise *)
Fixpoint remove_one (v : nat) (s : bag) : bag :=
  match s with
  | nil => nil
  | x :: t => if eqb x v
                  then t
                else
                  x :: remove_one v t
  end.

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

Fixpoint remove_all (v:nat) (s:bag) : bag :=
  match s with
  | nil => nil
  | x :: t => if eqb x v
                  then remove_all v t
                else
                  x :: remove_all v t
  end.

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

Fixpoint subset (s1 : bag) (s2 : bag) : bool :=
  match s1, s2 with
  | nil, _ => true
  | _, nil => false
  | x :: t, s2 => if member x s2
                        then subset t (remove_all x s2)
                      else
                        false
  end.

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

(* Exercise *)
Theorem bag_count_add :
  forall v n bag, count v bag = n -> count v (add v bag) = S n.
Proof.
  intros v n bag.
  simpl. intros H.
  rewrite H.
  assert (forall m, eqb m m = true) as HH.
  { induction m.
    - reflexivity.
    - simpl. rewrite IHm. reflexivity.
  }
  rewrite HH. apply add_comm.
Qed.

(* Definition *)
Theorem nil_app : forall l : natlist,
  [] ++ l = l.
Proof. reflexivity. Qed.

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

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

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

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

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

(* Exercise *)
Theorem app_nil_r : forall l : natlist,
  l ++ [] = l.
Proof.
  intros l. induction l as [|x xs].
  - reflexivity.
  - simpl. rewrite -> IHxs. reflexivity.
Qed.

Theorem rev_app_distr: forall l1 l2 : natlist,
  rev (l1 ++ l2) = rev l2 ++ rev l1.
Proof.
  intros l1 l2. induction l1 as [|x xs].
  - (*Case "[]"*)
    simpl.
    rewrite app_nil_r.
    reflexivity.
  - (*Case "x :: xs"*)
    simpl.
    rewrite IHxs.
    simpl.
    rewrite app_assoc.
    reflexivity.
Qed.

Theorem rev_involutive : forall l : natlist,
  rev (rev l) = l.
Proof.
  induction l as [| a l' IH].
  - reflexivity.
  - simpl. rewrite -> rev_app_distr. simpl. rewrite -> IH.
    reflexivity.
Qed.

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

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

Fixpoint eqblist (l1 l2 : natlist) : bool :=
  match l1, l2 with
  | nil, nil => true
  | nil, l2 => false
  | l1, nil => false
  | a :: l1', b :: l2' =>
    if a =? b then eqblist l1' l2'
    else false
  end.

Example test_eqblist1 : (eqblist nil nil = true).
Proof. reflexivity. Qed.
Example test_eqblist2 : eqblist [1;2;3] [1;2;3] = true.
Proof. reflexivity. Qed.
Example test_eqblist3 : eqblist [1;2;3] [1;2;4] = false.
Proof. reflexivity. Qed.

Theorem eqblist_refl : forall l : natlist,
  true = eqblist l l.
Proof.
  induction l as [| a l' IH].
  - reflexivity.
  - simpl. rewrite -> nat_equals_self. rewrite <- IH.
    reflexivity.
Qed.

(* Exercise *)
Theorem count_member_nonzero : forall s : bag,
  1 <=? (count 1 (1 :: s)) = true.
Proof.
  simpl. reflexivity.
Qed.

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

(* Exercise *)
Theorem remove_does_not_increase_count: forall (s : bag),
  (count 0 (remove_one 0 s)) <=? (count 0 s) = true.
Proof.
  intros s. induction s as [| n s'].
  - simpl. reflexivity.
  - destruct n.
    + simpl. rewrite leb_n_Sn. reflexivity.
    + simpl. rewrite IHs'. reflexivity. Qed.

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

(* Definition *)
Fixpoint nth_bad (l:natlist) (n:nat) : nat :=
  match l with
  | nil => 42
  | a :: l' => match n with
               | 0 => a
               | S n' => nth_bad l' n'
               end
  end.

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

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

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

(* Exercise *)
Definition hd_error (l : natlist) : natoption :=
  match l with
  | nil => None
  | a :: _ => Some a
  end.

Example test_hd_error1 : hd_error [] = None.
Proof. reflexivity. Qed.
Example test_hd_error2 : hd_error [1] = Some 1.
Proof. reflexivity. Qed.
Example test_hd_error3 : hd_error [5;6] = Some 5.
Proof. reflexivity. Qed.

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

End NatList.

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

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

(* Exercise *)
Theorem eqb_id_refl : forall x, true = eqb_id x x.
Proof.
  intro x.
  destruct x.
    simpl.
    rewrite -> nat_equals_self.
    reflexivity.
Qed.

(* Definition *)
Module PartialMap.

Export NatList.

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

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

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

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

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

End PartialMap.

(* Exercise *)

(* It has 2^n elements. *)


Add LoadPath "/Users/danielle/projects/software-foundations/chapter03".
Require Import case.

Require Import Utf8.

Theorem plus_0_r: ∀ n: nat, n + 0 = n.
Proof.
  intros n.
  induction n as [| n'].
  Case "n = 0".
    reflexivity.
  Case "n = S n’".
    simpl.
    rewrite -> IHn'.
    reflexivity.
    Qed.

(* Exercises *)

Theorem mult_0_r: ∀ n: nat,
  n * 0 = 0.
Proof.
  intros n.
  induction n as [| n'].
  Case "n = 0".
    reflexivity.
  Case "n = S n’".
    simpl.
    rewrite -> IHn'.
    reflexivity.
  Qed.

Theorem plus_n_Sm: ∀ n m: nat,
  S(n + m) = n + (S m).
Proof.
  intros n m.
  induction n as [| n'].
  Case "n = 0".
    reflexivity.
  Case "n = S n’".
    simpl.
    rewrite -> IHn'.
    reflexivity.
  Qed.

Theorem plus_comm: ∀ n m: nat,
  n + m = m + n.
Proof.
  intros n m.
  induction n as [| n'].
  Case "n = 0".
    rewrite -> plus_0_r.
    reflexivity.
  Case "n = S n’".
    simpl.
    rewrite -> IHn'.
    rewrite -> plus_n_Sm.
    reflexivity.
  Qed.

Theorem plus_assoc: ∀ n m p: nat,
  n + (m + p) = (n + m) + p.
Proof.
  intros n m p.
  induction n as [| n'].
  Case "n = 0".
    reflexivity.
  Case "n = S n’".
    simpl.
    rewrite -> IHn'.
    reflexivity.
  Qed.


(* Matrix manipulation

   File: 'matrix.v'

   Description: The main purpose of this file
   is to make available the necessary operations
   on matrices to test identities of the fibonacci
   sequence *)

Require Import Arith.

Require Import Lists.List.

(* Coq library from the fibonacci.v file

   Compile by entering the following in command line
   > coqc fibonacci.v *)

Require Import fibonacci.

(* A 2x2 matrix is a simple constructor
   with 4 nats.

   |a00 a01|
   |a10 a11|

*)

Inductive matrix22 :=
| Matrix22 : nat -> nat -> nat -> nat -> matrix22.

Definition matrix_1 := Matrix22 1 2 3 4.
Definition matrix_2 := Matrix22 5 6 7 8.
Definition matrix_3 := Matrix22 9 8 7 6.

(* The identity matrix

   |1 0|
   |0 1|

*)

Definition matrix_identity := Matrix22 1 0 0 1.

Lemma unfold_matrix_identity :
  matrix_identity = Matrix22 1 0 0 1.
Proof.
  unfold matrix_identity.
  reflexivity.
Qed.

(* Addition of two matrices *)

Definition matrix_plus (m m' : matrix22) : matrix22 :=
  match (m, m') with
    | (Matrix22 a00 a01 a10 a11, Matrix22 b00 b01 b10 b11)
      => Matrix22 (a00 + b00) (a01 + b01) (a10 + b10) (a11 + b11)
  end.

Lemma unfold_matrix_plus :
  forall m m' : matrix22,
    matrix_plus m m' =
    match (m, m') with
      | (Matrix22 a00 a01 a10 a11, Matrix22 b00 b01 b10 b11)
        => Matrix22 (a00 + b00) (a01 + b01) (a10 + b10) (a11 + b11)
    end.
Proof.
  unfold matrix_plus.
  reflexivity.
Qed.

(* Addition test

   |1 2|  +  |5 6|  =  | 6  8|
   |3 4|  +  |7 8|  =  |10 12|

*)

Compute matrix_plus matrix_1 matrix_2.

(* Matrix22 6 8 10 12
    : matrix22      *)

(* Scalar product of natural number and matrix *)

Definition matrix_scalar (c : nat) (m : matrix22) :=
  match m with
    | Matrix22 a00 a01 a10 a11
      => Matrix22 (a00 * c) (a01 * c) (a10 * c) (a11 * c)
  end.

Lemma unfold_matrix_scalar :
  forall (m : matrix22) (c : nat),
    matrix_scalar c m =
    match m with
      | Matrix22 a00 a01 a10 a11
        => Matrix22 (a00 * c) (a01 * c) (a10 * c) (a11 * c)
    end.
Proof.
  unfold matrix_scalar.
  reflexivity.
Qed.

Compute matrix_scalar 10 matrix_1.

(* Matrix22 10 20 30 40
    : matrix22        *)

(* Ordinary matrix multiplication *)

Definition matrix_multiplication (m m' : matrix22) :=
  match (m, m') with
    | (Matrix22 a00 a01 a10 a11, Matrix22 b00 b01 b10 b11)
      => Matrix22 (a00 * b00 + a01 * b10) (a00 * b01 + a01 * b11) (a10 * b00 + a11 * b10) (a10 * b01 + a11 * b11)
  end.

Lemma unfold_matrix_multiplication :
  forall m m' : matrix22,
    matrix_multiplication m m' = match (m, m') with
    | (Matrix22 a00 a01 a10 a11, Matrix22 b00 b01 b10 b11)
      => Matrix22 (a00 * b00 + a01 * b10) (a00 * b01 + a01 * b11) (a10 * b00 + a11 * b10) (a10 * b01 + a11 * b11)
  end.
Proof.
  unfold matrix_multiplication.
  reflexivity.
Qed.

(* Multiplication test

   |1 2|  *  |5 6|  =  | 19  22|
   |3 4|  *  |7 8|  =  | 43  50|

*)

Compute matrix_multiplication matrix_1 matrix_2.

(* Matrix22 19 22 43 50
    : matrix22    *)

(* Identity matrix is neutral *)

Lemma matrix_identity_is_neutral_on_the_left :
  forall m : matrix22,
    matrix_multiplication matrix_identity m = m.
Proof.
  intro m.
  rewrite unfold_matrix_identity.
  rewrite unfold_matrix_multiplication.
  case m as [ a00 a01 a10 a11 ].
  rewrite 4 mult_1_l.
  rewrite 4 mult_0_l.
  rewrite 2 plus_0_r.
  rewrite 2 plus_0_l.
  reflexivity.
Qed.

Lemma matrix_identity_is_neutral_on_the_right :
  forall m : matrix22,
    matrix_multiplication m matrix_identity = m.
Proof.
  intro m.
  rewrite unfold_matrix_identity.
  rewrite unfold_matrix_multiplication.
  case m as [ m00 m01 m10 m11 ].
  rewrite 4 mult_1_r.
  rewrite 4 mult_0_r.
  rewrite 2 plus_0_r.
  rewrite 2 plus_0_l.
  reflexivity.
Qed.

(* Matrix multiplication is associative *)

Lemma matrix_multiplication_is_associative :
  forall a b c : matrix22,
    matrix_multiplication (matrix_multiplication a b) c = matrix_multiplication a (matrix_multiplication b c).
Proof.
  intros a b c.
  rewrite 4 unfold_matrix_multiplication.
  destruct a as [a00 a01 a10 a11].
  destruct b as [b00 b01 b10 b11].
  destruct c as [c00 c01 c10 c11].
  rewrite 8 mult_plus_distr_r.
  rewrite 8 mult_plus_distr_l.
  rewrite 16 mult_assoc.
  rewrite 8 plus_assoc.
  rewrite <- (plus_assoc (a00 * b00 * c00)).
  rewrite (plus_comm (a01 * b10 * c00)).
  rewrite <- (plus_assoc (a00 * b00 * c01)).
  rewrite (plus_comm (a01 * b10 * c01)).
  rewrite <- (plus_assoc (a10 * b00 * c00)).
  rewrite (plus_comm (a11 * b10 * c00)).
  rewrite <- (plus_assoc (a10 * b00 * c01)).
  rewrite (plus_comm (a11 * b10 * c01)).
  rewrite 4 plus_assoc.
  reflexivity.
Qed.

(* Multiplication is associative test

   (A * B) * C = A * (B * C)
*)

Compute (matrix_multiplication
        (matrix_multiplication matrix_1 matrix_2)
         matrix_3)
        =
        (matrix_multiplication
         matrix_1
        (matrix_multiplication  matrix_2 matrix_3)).

(* Matrix22 325 284 737 644 = Matrix22 325 284 737 644
     : Prop  *)

(* Matrix exponentiation function

   Base case is defined by the identity
   matrix thus A^0=I *)

Fixpoint matrix_exponentiation (m : matrix22) (n : nat) : matrix22 :=
  match n with
    | 0 => matrix_identity
    | S n' => matrix_multiplication (matrix_exponentiation m n') m
  end.

Lemma unfold_matrix_exponentiation_bc :
  forall (m : matrix22),
    matrix_exponentiation m 0 = matrix_identity.
Proof.
  unfold matrix_exponentiation.
  reflexivity.
Qed.

Lemma unfold_matrix_exponentiation_ic :
  forall (m : matrix22) (n : nat),
    matrix_exponentiation m (S n) = matrix_multiplication (matrix_exponentiation m n) m.
Proof.
  unfold matrix_exponentiation.
  reflexivity.
Qed.

(* Properties of matrix exponentiation

   This identity is proposition 14
   in dProgSprog notes. *)

Theorem exponentiation_of_a_matrix :
  forall (n : nat),
    matrix_exponentiation (Matrix22 1 1 0 1) n =
    Matrix22 1 n 0 1.
Proof.
  intro n.
  induction n as [ | n' IHn'].
  rewrite unfold_matrix_exponentiation_bc.
  rewrite unfold_matrix_identity.
  reflexivity.

  rewrite unfold_matrix_exponentiation_ic.
  rewrite unfold_matrix_multiplication.
  rewrite IHn'.
  rewrite 3 mult_1_r.
  rewrite 2 mult_0_r.
  rewrite 2 plus_0_r.
  rewrite plus_Sn_m.
  rewrite 2 plus_0_l.
  reflexivity.
Qed.

Lemma about_matrix_exponentiation_left :
  forall (a : matrix22) (n : nat),
    matrix_multiplication a (matrix_exponentiation a n) =
    matrix_exponentiation a (S n).
Proof.
  intros a n.
  induction n as [ | n'].
  rewrite unfold_matrix_exponentiation_bc.
  rewrite unfold_matrix_exponentiation_ic.
  rewrite unfold_matrix_exponentiation_bc.
  rewrite matrix_identity_is_neutral_on_the_left.
  rewrite matrix_identity_is_neutral_on_the_right.
  reflexivity.

  rewrite unfold_matrix_exponentiation_ic.
  rewrite unfold_matrix_exponentiation_ic.
  rewrite <- IHn'.
  rewrite matrix_multiplication_is_associative.
  reflexivity.
Qed.

Lemma about_matrix_exponentiation_right :
  forall (a : matrix22) (n : nat),
    matrix_multiplication (matrix_exponentiation a n) a =
    matrix_exponentiation a (S n).
Proof.
  intros a n.
  induction n as [ | n'].
  rewrite unfold_matrix_exponentiation_bc.
  rewrite unfold_matrix_exponentiation_ic.
  rewrite unfold_matrix_exponentiation_bc.
  rewrite matrix_identity_is_neutral_on_the_left.
  reflexivity.

  rewrite unfold_matrix_exponentiation_ic.
  rewrite unfold_matrix_exponentiation_ic.
  rewrite <- IHn'.
  reflexivity.
Qed.

(* Proposition 29 in dProgSprog notes *)

Proposition about_matrix_exponentiation :
  forall (m : matrix22) (n : nat),
    matrix_multiplication (matrix_exponentiation m n) m =
    matrix_multiplication m (matrix_exponentiation m n).
Proof.
  intros m n.
  rewrite about_matrix_exponentiation_left.
  apply about_matrix_exponentiation_right.
Qed.

(* Transposition of matrix *)

Definition matrix_transposition (m : matrix22) : matrix22 :=
  match m with
    | Matrix22 a00 a01 a10 a11
      => Matrix22 a00 a10 a01 a11
  end.

Lemma unfold_matrix_transposition :
  forall m : matrix22,
    matrix_transposition m =
      match m with
        | Matrix22 a00 a01 a10 a11
          => Matrix22 a00 a10 a01 a11
      end.
Proof.
  unfold matrix_transposition.
  reflexivity.
Qed.

(* Transposition of a matrix test

       T
  |1 2|  =  |1  3|
  |3 4|  =  |2  4|   *)

Compute matrix_transposition matrix_1.

(* Matrix22 1 3 2 4
    : matrix22       *)

(* Properties about matrix transposition *)

Lemma matrix_identity_is_symmetric :
  matrix_transposition matrix_identity =
  matrix_identity.
Proof.
  rewrite unfold_matrix_transposition.
  rewrite unfold_matrix_identity.
  reflexivity.
Qed.

Lemma matrix_transposition_is_involutive :
  forall m : matrix22,
    matrix_transposition (matrix_transposition m) = m.
Proof.
  intro a.
  rewrite 2 unfold_matrix_transposition.
  destruct a as [a00 a01 a10 a11].
  reflexivity.
Qed.

(* Transposition of a matrix product

   When you transpose a product you
   get the product of the transposed
   matrices in reverse order *)

Proposition transposition_of_a_product :
  forall a b : matrix22,
    matrix_transposition (matrix_multiplication a b) =
    matrix_multiplication (matrix_transposition b) (matrix_transposition a).
Proof.
  intros a b.
  destruct a as [a00 a01 a10 a11].
  destruct b as [b00 b01 b10 b11].
  rewrite 3 unfold_matrix_transposition.
  rewrite 2 unfold_matrix_multiplication.
  rewrite (mult_comm a00).
  rewrite (mult_comm a01).
  rewrite (mult_comm a10).
  rewrite (mult_comm a11).
  rewrite (mult_comm b01).
  rewrite (mult_comm b11).
  rewrite (mult_comm b01).
  rewrite (mult_comm b11).
  reflexivity.
Qed.

(* Transposition and exponentiation commutes

   Proposition 38 in dProgSprog notes *)

Theorem matrix_transposition_and_exponentiation_commutes :
  forall (m : matrix22) (n : nat),
    matrix_transposition (matrix_exponentiation m n) =
    matrix_exponentiation (matrix_transposition m) n.
Proof.
  intros m n.
  induction n as [ | n' IHn'].
  rewrite 2 unfold_matrix_exponentiation_bc.
  rewrite matrix_identity_is_symmetric.
  reflexivity.

  destruct m as [m00 m01 m10 m11].
  rewrite (unfold_matrix_exponentiation_ic (matrix_transposition (Matrix22 m00 m01 m10 m11))).
  rewrite <- IHn'.
  rewrite <- transposition_of_a_product.
  rewrite about_matrix_exponentiation_left.
  reflexivity.
Qed.

(* Determinant of 2x2 matrix *)

Definition matrix_determinant (m : matrix22) : nat :=
  match m with
    | Matrix22 a00 a01 a10 a11
      => a00 * a11 - a01 * a10
  end.

Lemma unfold_matrix_determinant :
  forall m : matrix22,
    matrix_determinant m =
    match m with
      | Matrix22 a00 a01 a10 a11
        => a00 * a11 - a01 * a10
    end.
Proof.
  unfold matrix_determinant.
  reflexivity.
Qed.

Compute matrix_determinant (Matrix22 10 4 9 9).
(*  54
    : nat *)

(* Defining the fibonacci matrix to raise to a power *)

Definition matrix_fib := Matrix22 1 1 1 0.

Lemma unfold_matrix_fib :
  matrix_fib = Matrix22 1 1 1 0.
Proof.
  unfold matrix_fib.
  reflexivity.
Qed.

(* Matrix exponentiation and fibonacci

   Showing the beautiful relation between
   matrix exponentiation of the matrix_fib
   and the fibonacci sequence *)

Theorem matrix_exponentiation_and_fibonacci :
  forall (fib : nat -> nat),
    specification_of_fibonacci fib ->
    forall n : nat,
      (matrix_exponentiation matrix_fib (S n)) = Matrix22 (fib (S (S n))) (fib (S n)) (fib (S n)) (fib n).
Proof.
  intro fib.
  intro H_fib.
  destruct H_fib as [H_fib_bc0 [H_fib_bc1 H_fib_ic]].
  intro n.
  induction n as [ | n' IHn'].
  rewrite H_fib_ic.
  rewrite H_fib_bc0.
  rewrite H_fib_bc1.
  rewrite plus_0_r.
  rewrite unfold_matrix_exponentiation_ic.
  rewrite matrix_identity_is_neutral_on_the_left.
  reflexivity.

  rewrite unfold_matrix_exponentiation_ic.
  rewrite unfold_matrix_multiplication.
  rewrite IHn'.
  rewrite unfold_matrix_fib.
  rewrite 3 mult_1_r.
  rewrite 2 mult_0_r.
  rewrite 2 plus_0_r.
  rewrite <- 2 H_fib_ic.
  reflexivity.
Qed.

(* Matrix implementation of fibonacci

   New implementation of the Fibonacci function
   maybe also be a bit more efficient *)

Fixpoint fib_v3 (n : nat) : nat :=
  match (matrix_exponentiation (Matrix22 1 1 1 0) n) with
    | Matrix22 _ a01 _ _ => a01
  end.

Compute map fib_v3 (0 :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: nil).
(*                  0 :: 1 :: 1 :: 2 :: 3 :: 5 :: 8 :: 13 :: nil
                    : list nat *)

Lemma unfold_fib_v3_bc :
  fib_v3 0 =
  match (matrix_exponentiation matrix_fib 0) with
    | Matrix22 _ a01 _ _ => a01
  end.
Proof.
  unfold fib_v3.
  reflexivity.
Qed.

Lemma fib_v3_of_0 :
  fib_v3 0 = 0.
Proof.
  rewrite unfold_fib_v3_bc.
  rewrite unfold_matrix_exponentiation_bc.
  rewrite unfold_matrix_identity.
  reflexivity.
Qed.

Lemma unfold_fib_v3_ic :
  forall n : nat,
    fib_v3 (S n) =
    match (matrix_exponentiation matrix_fib (S n)) with
      | Matrix22 _ a01 _ _ => a01
    end.
Proof.
  unfold fib_v3.
  reflexivity.
Qed.

(* Fibonacci function in direct style

   Implementation from
   'fibonacci-with-some-solutions.v' *)

Fixpoint fib_v1 (n : nat) : nat :=
  match n with
    | 0 => 0
    | S n' => match n' with
                | 0 => 1
                | S n'' => fib_v1 n' + fib_v1 n''
              end
  end.

Lemma unfold_fib_v1_base_case_0 :
  fib_v1 0 = 0.
Proof.
  unfold fib_v1.
  reflexivity.
Qed.

Lemma unfold_fib_v1_base_case_1 :
  fib_v1 1 = 1.
Proof.
  unfold fib_v1.
  reflexivity.
Qed.

Lemma unfold_fib_v1_induction_case :
  forall n'' : nat,
    fib_v1 (S (S n'')) = fib_v1 (S n'') + fib_v1 n''.
Proof.
  intro n''.
  unfold fib_v1; fold fib_v1.
  reflexivity.
Qed.

Theorem fib_v1_fits_the_specification_of_fibonacci :
  specification_of_fibonacci fib_v1.
Proof.
  unfold specification_of_fibonacci.
  split.
  apply unfold_fib_v1_base_case_0.
  split.
  apply unfold_fib_v1_base_case_1.
  apply unfold_fib_v1_induction_case.
Qed.

(* fib_v1 and fib_v3 are functionally equal

   For any natural number n the output
   of fib_v1 and fib_v3 are the same *)

Proposition fib_v1_and_fib_v3_are_functionally_equal :
  forall n : nat,
    fib_v3 n = fib_v1 n.
Proof.
  intro n.
  induction n as [ | | n' IHn' IHSn'] using nat_ind2.
  rewrite fib_v3_of_0.
  rewrite unfold_fib_v1_base_case_0.
  reflexivity.

  rewrite unfold_fib_v3_ic.
  rewrite unfold_fib_v1_base_case_1.
  rewrite unfold_matrix_exponentiation_ic.
  rewrite unfold_matrix_exponentiation_bc.
  rewrite matrix_identity_is_neutral_on_the_left.
  rewrite unfold_matrix_fib.
  reflexivity.

  rewrite unfold_fib_v3_ic.
  rewrite (matrix_exponentiation_and_fibonacci fib_v1 fib_v1_fits_the_specification_of_fibonacci).
  reflexivity.
Qed.

(* fib_v3 satisfies the specification of Fibonacci

   Since fib_v1 and fib_v3 are functionally equal
   it is straight forward to show that fib_v3 satisfies the
   specification since it is already shown that
   fib_v1 satisfies the specification. *)

Theorem fib_v3_satisfies_the_specification_of_fibonacci :
  specification_of_fibonacci fib_v3.
Proof.
  unfold specification_of_fibonacci.
  rewrite 2 fib_v1_and_fib_v3_are_functionally_equal.
  destruct fib_v1_fits_the_specification_of_fibonacci
    as [fib_v1_bc0 [fib_v1_bc1 fib_v1_ic]].
  split.
  apply fib_v1_bc0.
  split.
  apply fib_v1_bc1.
  intro n.
  rewrite 3 fib_v1_and_fib_v3_are_functionally_equal.
  apply fib_v1_ic.
Qed.

(* Cassini's identity with matrices

   This implementation uses a fibonacci
   function to create the fibonacci matrix.
   And afterwards the definition of the
   determinant ensures an expression
   where Cassini_s_identity_for_even_numbers
   can be used. *)

Theorem Cassini_and_matrices_even :
  forall (fib : nat -> nat) (n : nat),
    specification_of_fibonacci fib ->
    matrix_determinant (matrix_exponentiation matrix_fib (2 * (S n))) = 1.
Proof.
  intros fib n.
  intro H_fib.
  assert (H_tmp := H_fib).
  destruct H_fib as [H_fib_bc0 [H_fib_bc1 H_fib_ic]].

  rewrite unfold_matrix_fib.
  rewrite mult_succ_l.
  rewrite mult_1_l.
  rewrite plus_Sn_m.
  rewrite <- plus_n_Sm.
  rewrite (matrix_exponentiation_and_fibonacci fib H_tmp).
  rewrite <- plus_Sn_m.
  rewrite plus_n_Sm.
  rewrite (plus_Sn_m n n).
  rewrite 2 plus_2_mult.
  rewrite unfold_matrix_determinant.
  rewrite <- (Cassini_s_identity_for_even_numbers fib H_tmp n).
  rewrite unfold_square.
  rewrite <- minus_Sn_m.
  rewrite minus_diag.
  reflexivity.

  reflexivity.
Qed.

Theorem Cassini_and_matrices_odd :
  forall (fib : nat -> nat) (n : nat),
    specification_of_fibonacci fib ->
   S (S (matrix_determinant (matrix_exponentiation matrix_fib (S (2 * n))))) = 1.
Proof.
  intros fib n.
  intro H_fib.
  assert (H_tmp := H_fib).
  destruct H_fib as [H_fib_bc0 [H_fib_bc1 H_fib_ic]].

  rewrite unfold_matrix_fib.
  rewrite mult_succ_l.
  rewrite mult_1_l.
  rewrite (matrix_exponentiation_and_fibonacci fib H_tmp).
  rewrite <- plus_Sn_m.
  rewrite plus_n_Sm.
  rewrite 2 plus_2_mult.
  rewrite plus_Sn_m.
  rewrite plus_2_mult.
  rewrite unfold_matrix_determinant.
  rewrite <- fibonacci.unfold_square.
  rewrite (Cassini_s_identity_for_odd_numbers fib H_tmp n).
  rewrite minus_Sn_m.
  rewrite minus_diag.
  reflexivity.
  (* Will not appear in the report *)
  Abort.

(* End of 'matrix.v' *)


Require Export D.

(** **** Exercise: 3 stars (nostutter)  *)
(** Formulating inductive definitions of predicates is an important
    skill you'll need in this course.  Try to solve this exercise
    without any help at all.

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

Inductive nostutter:  list nat -> Prop :=
| ns_nil : nostutter []
| ns_single : forall n, nostutter [n]
| ns_cons : forall x1 x2 l, (x1<>x2) -> nostutter (x2::l) -> nostutter (x1::x2::l)
.

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

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

Example test_nostutter_1:      nostutter [3;1;4;1;5;6].
Proof. apply ns_cons.
  intro c. inversion c. apply ns_cons. intro c. inversion c. apply ns_cons. intro c. inversion c. apply ns_cons. intro c. inversion c. apply ns_cons. intro c. inversion c. apply ns_single. Qed.

(*
  Proof. repeat constructor; apply beq_nat_false; auto. Qed.
*)

Example test_nostutter_2:  nostutter [].
Proof. apply ns_nil. Qed.
(*
  Proof. repeat constructor; apply beq_nat_false; auto. Qed.
*)

Example test_nostutter_3:  nostutter [5].
Proof. apply ns_single. Qed.
(*
  Proof. repeat constructor; apply beq_nat_false; auto. Qed.
*)

Example test_nostutter_4:      not (nostutter [3;1;1;4]).
Proof.
  unfold not. intro c. inversion c. inversion H3. unfold not in H6. apply H6. reflexivity. Qed.

(*
  Proof. intro.
  repeat match goal with
    h: nostutter _ |- _ => inversion h; clear h; subst
  end.
  contradiction H1; auto. Qed.
*)


Require Import ZArith.

Record plane : Set := point {abscissa : Z; ordinate : Z}.

Open Scope Z_scope.

Definition manhattan_dist (p1 p2 : plane) : Z :=
 (Zabs (abscissa p1 - abscissa p2)) +
 (Zabs (ordinate p1 - ordinate p2)).

Eval compute in (manhattan_dist (point 2 5) (point 7 (-9))).


From LF Require Export Basics.

Theorem add_0_r_firsttry: forall n:nat,
  n + 0 = n.

Proof.
  intros n.
  simpl.
Abort.

Theorem add_0_r: forall n: nat, n + 0 = n.
Proof.
  intros n. induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite -> IHn'. reflexivity. Qed.

Theorem minus_n_n : forall n, minus n n = 0.
Proof.
  intros n. induction n as [|n' IHn'].
  - simpl. reflexivity.
  - simpl. rewrite -> IHn'. reflexivity. Qed.

Theorem mul_0_r : forall n: nat,
  n * 0 = 0.
Proof.
  induction n as [|n' IHn'].
  - simpl. reflexivity.
  - simpl. rewrite -> IHn'. reflexivity. Qed.

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

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

Theorem add_assoc: forall n m p:nat,
  n+(m+p) = (n+m)+p.
Proof.
  induction n as [|n' IHn'].
  - intros. simpl. reflexivity.
  - intros. simpl. rewrite -> IHn'. reflexivity. Qed.

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

Lemma double_plus: forall n, double n = n + n.
Proof.
  induction n as [|n' IHn'].
  - simpl. reflexivity.
  - simpl. rewrite -> IHn'. rewrite plus_n_Sm. reflexivity. Qed.

Theorem eqb_refl: forall n: nat,
  (n =? n) = true.
Proof.
  induction n as [|n' IHn'].
  - simpl. reflexivity.
  - simpl. apply IHn'. Qed.

Theorem even_S : forall n : nat,
  even (S n) = negb (even n).
Proof.
  induction n as [|n' IHn'].
  - simpl. reflexivity.
  - rewrite IHn'. rewrite negb_involutive. simpl. reflexivity. Qed.

Theorem mult_0_plus' : forall n m : nat,
  (n + 0 + 0) * m = n * m.
Proof.
  intros n m.
  assert (H: n + 0 + 0 = n).
    { rewrite add_comm. simpl. rewrite add_comm. reflexivity. }
  rewrite -> H.
  reflexivity. Qed.

Theorem plus_rearrange : forall n m p q : nat,
  (n + m) + (p + q) = (m + n) + (p + q).
Proof.
  intros n m p q.
  assert (H: n + m = m + n).
  { rewrite add_comm. reflexivity. }
  rewrite H. reflexivity. Qed.

Theorem add_shuffle3: forall n m p:nat,
  n+(m+p) = m+(n+p).
Proof.
  intros.
  rewrite add_assoc.
  rewrite add_assoc.
  assert (H:n+m=m+n). apply add_comm.
  rewrite H. reflexivity. Qed.

Theorem mul_comm: forall m n : nat,
  m * n = n * m.
Proof.
  induction m.
  - intros. simpl. rewrite mul_0_r. reflexivity.
  - intros. simpl. rewrite IHm. assert (H: n + n * m = n * S m).
    { induction n.
    - simpl. reflexivity.
    - simpl. rewrite <- IHn. rewrite add_shuffle3. reflexivity. }
    apply H. Qed.

Check leb.

Theorem plus_leb_compat_l: forall n m p: nat,
  n <=? m = true -> (p + n) <=? (p +  m) = true.
Proof.
  intros n. intros m. induction p.
  - simpl. intros. apply H.
  - intros. simpl. rewrite IHp. reflexivity. apply H. Qed.

Theorem leb_refl: forall n: nat,
  (n <=? n) = true.
Proof.
  induction n. simpl. reflexivity. simpl. apply IHn. Qed.

Theorem zero_neqb_S: forall n: nat,
  0 =? (S n) = false.
Proof.
  intros. simpl. reflexivity.
Qed.

Theorem andb_false_r: forall b: bool,
  andb b false = false.
Proof.
  intros. destruct b. simpl. reflexivity. simpl. reflexivity.
Qed.

Theorem S_neqb_0: forall n:nat,
  (S n) =? 0 = false.
Proof.
  reflexivity.
Qed.

Theorem mult_1_l: forall n:nat, 1 * n = n.
Proof.
  intros n.
  simpl.
  rewrite <- plus_n_O.
  reflexivity. Qed.

  Theorem all3_spec : forall b c : bool,
  orb (andb b c) (orb (negb b) (negb c)) = true.
Proof.
  destruct b.
  - simpl. destruct c.
    + reflexivity.
    + reflexivity.
  - reflexivity.
Qed.

Theorem mult_plus_distr_r: forall n m p: nat,
  (n + m) * p = (n * p) + (m * p).
Proof.
  intros. induction n as [| n IHn].
  - reflexivity.
  - simpl. rewrite -> IHn. rewrite <- add_assoc. reflexivity.
Qed.

Theorem mult_assoc : forall n m p : nat,
  n * (m * p) = (n * m) * p.
Proof.
  intros.
  induction n as [| n IHn].
  - reflexivity.
  - simpl. rewrite -> IHn. rewrite <- mult_plus_distr_r. reflexivity.
Qed.

Theorem add_shuffle3': forall n m p:nat,
  n+(m+p) = m+(n+p).
Proof.
  intros.
  rewrite add_assoc.
  rewrite add_assoc.
  replace (n + m) with (m + n). reflexivity. apply add_comm. Qed.

Theorem bin_to_nat_pres_incr : forall n:bin,
  bin_to_nat (incr n) = S (bin_to_nat n).
Proof.
  assert (H: forall m: nat, m * 2 = m + m). {
    intros.
    rewrite -> mul_comm. simpl. rewrite <- plus_n_O. reflexivity.
  }
  induction n as [|n IHn|n IHn].
  - reflexivity.
  - simpl.
    rewrite -> H. rewrite -> plus_n_Sm. replace (S (bin_to_nat n)) with (bin_to_nat n + 1).
    + rewrite -> add_assoc. reflexivity.
    + rewrite -> add_comm. rewrite -> plus_1_l. reflexivity.
  - simpl. rewrite -> H. rewrite -> H. rewrite -> IHn. rewrite -> plus_n_Sm.
    rewrite <- plus_1_l. rewrite -> add_assoc.
    assert (H2: forall k:nat, 1 + k + 1 + k = k + k + 2). {
      intros. replace (k + k + 2) with (k + 2 + k).
      + replace (k + 2) with (1 + k + 1).
        * reflexivity.
        * rewrite <- add_assoc. rewrite add_comm. replace (k+1+1) with
        (k+(1+1)). reflexivity. rewrite add_assoc. reflexivity.
      + rewrite <- add_assoc. replace (2+k) with (k+2). rewrite add_assoc.
      reflexivity. apply add_comm.
    }
    rewrite -> H2. reflexivity.
Qed.

Fixpoint nat_to_bin (n:nat) : bin :=
  match n with
  | O => Z
  | S n' => incr(nat_to_bin(n')) end.

Theorem nat_bin_nat : forall n, bin_to_nat (nat_to_bin n) = n.
Proof.
  induction n as [|n' IHn'].
  - reflexivity.
  - simpl. rewrite bin_to_nat_pres_incr. rewrite IHn'. reflexivity. Qed.

(* TODO: solve Bin to Nat and Back to Bin. *)


Require Import Arith.
Require Import List.
Import ListNotations.

Inductive tree : Set :=
| leaf : tree
| node : tree -> nat -> tree -> tree.

Fixpoint all_leq(n: nat)(t: tree): Prop :=
  match t with
    | leaf => True
    | node l val r => (val <= n) /\ (all_leq n l) /\ (all_leq n r)
  end.

Fixpoint all_geq(n: nat)(t: tree): Prop :=
  match t with
    | leaf => True
    | node l val r => (val > n) /\ (all_geq n l) /\ (all_geq n r)
  end.

Fixpoint bst (T: tree): Prop :=
  match T with
  | leaf => True
  | node l v r => (all_leq v l) /\ (all_geq v r) /\ bst l /\ bst r
end.

Fixpoint insert(n: nat)(T: tree): tree :=
  match T with
  | leaf => node leaf n leaf
  | node l v r => if Nat.leb n v then (insert n l) else (insert n r)
  end.

(*Print Nat.*)

Lemma insert_correctness: forall t: tree, forall n: nat, bst t -> bst (insert n t).
Proof.
intros.
induction t.
* simpl.
  auto.
* simpl insert.
  destruct (n <=? n0).
  apply IHt1.
  destruct H as [H1 [H2 [H3 H4]]].
  auto.
  apply IHt2.
  destruct H as [H1 [H2 [H3 H4]]].
  auto.
Qed.

Fixpoint occurs(n: nat)(t: tree): Prop :=
  match t with
    | leaf => False
    | node l v r => v = n \/ occurs n l \/ occurs n r
  end.

Fixpoint to_list(T: tree): (list nat) :=
  match T with
    | leaf => nil
    | node l v r => (to_list l) ++  v::(to_list r)
  end.

Lemma list_tree_equality: forall t1 t2: tree, forall n: nat,
  to_list (node t1 n t2) = (to_list t1) ++ n::(to_list t2).
Proof.
intros.
induction t1.
  * induction t2.
    simpl; reflexivity.
    simpl. reflexivity.
  * induction t2.
    simpl. reflexivity.
    simpl; reflexivity.
Defined.

Lemma to_list_retains_elements: forall t: tree, forall x: nat,
  occurs x t -> In x (to_list t).
Proof.
intros.
induction t.
- simpl. simpl in H. assumption.
- simpl in H.
  destruct H.
  * rewrite H.
    simpl.
    apply in_elt.
  * destruct H.
    + simpl.
      apply in_or_app.
      left; apply IHt1; assumption.
    + simpl.
      apply in_or_app.
      right.
      apply in_cons.
      apply IHt2; assumption.
Defined.

Fixpoint insert_sorted(l: (list nat))(ele: nat): (list nat) :=
  match l with
    | nil => [ele]
    | cons x xs => if x <? ele then [x] ++ (insert_sorted xs ele)
      else ele::x::nil ++ xs
  end.

Lemma insert_sorted_retains_elements: forall l :(list nat), forall x n: nat,
  In x l -> In x (insert_sorted l n).
Proof.
intros.
induction l.
- simpl; right; contradiction.
- simpl.
  destruct (a <? n).
  * simpl.
    simpl in H.
    destruct H as [H1 | H2].
    left; assumption.
    right; apply IHl; assumption.
  * simpl; simpl in H.
    destruct H as [H1 | H2].
    right; left; assumption.
    right; right; assumption.
Defined.

Lemma insert_sorted_inserts_element: forall l: (list nat), forall n: nat,
  In n (insert_sorted l n).
Proof.
intros.
induction l.
- simpl. left. reflexivity.
- simpl.
  destruct (a <? n).
  * simpl; right; assumption.
  * simpl. left. reflexivity.
Defined.

Fixpoint sort_list(l: (list nat)): (list nat) :=
  match l with
    | nil => nil
    | cons x xs => insert_sorted (sort_list xs) x
  end.

(*
Compute(sort_list (5::1::3::2::nil)).
Compute(sort_list nil).
Compute(sort_list (22::22::11::11::5::1::2::nil)).
*)

Lemma sorted_list_contains_elements: forall l: (list nat), forall n: nat,
  In n l -> In n (sort_list l).
Proof.
intros.
induction l.
- simpl; auto.
- simpl.
  simpl in H.
  destruct H.
  * rewrite H.
    apply insert_sorted_inserts_element.
  * apply insert_sorted_retains_elements.
    apply IHl.
    assumption.
Defined.

Fixpoint to_tree(l: (list nat)): tree :=
  match l with
    | nil => leaf
    | cons x xs => node leaf x (to_tree xs)
  end.

Definition sort(t: tree): tree :=
  to_tree (sort_list (to_list t)).

(*
Compute(sort (node (node leaf 11 leaf) 44 (node leaf 1 leaf))).
Compute(sort (node leaf 1 (node leaf 2 (node leaf 3 leaf)))).
*)

(*sort_list (to_list t1 ++ n :: to_list t2))*)

Lemma occurs_bst_forward: forall t: tree, forall x: nat,
  occurs x t -> occurs x (sort t).
Proof.
intros.
unfold sort.

Lemma sort_result_bst: forall t: tree, bst (sort t).
Proof.
intros.
unfold sort.
(* then here *)


Require Import Arith.
Require Import Omega.

Fixpoint div2 (n:nat) : nat := match n with S (S p) => S (div2 p) | _ => 0 end.

(* as we advised in chapter 9, we use a specific induction principle
   to reason on the division function. *)

Theorem div2_ind :
 forall P:nat->Prop,
   P 0 -> P 1 -> (forall n, P n -> P (S (S n))) ->
   forall n, P n.
Proof.
 intros.
 assert (H' : P n /\ P (S n)).
 elim n; intuition.
 intuition.
Qed.

(* Once the induction principle breaks down the problem into the
   various cases, the omega tactic can handle them. *)

Theorem double_div2_le : forall x:nat, div2 x + div2 x <= x.
Proof.
 intros x; elim x using div2_ind; simpl; auto.
 intros; omega.
Qed.

(* Here we don't even need a proof by induction, but the previous
   theorem must be re-used. *)
Theorem f_lemma : forall x v, v <= div2 x -> div2 x + v <= x.
Proof.
 intros; generalize (double_div2_le x); omega.
Qed.


Require Import Omega.

Module Beaf.

  Notation "a ^ b" := (Nat.pow a b) (right associativity, at level 30).

  Example power_example1 :
    2 ^ 2 ^ 3 = 256.
  Proof.
    reflexivity.
  Qed.

  Definition googol := 10 ^ 100.
  Definition googolplex := 10 ^ googol.

  Fixpoint tetration (a:nat) (b:nat) : nat :=
    match b with
    | O => 1
    | S b' => a ^ (tetration a b')
    end.

  Notation "a ^^ b" := (tetration a b) (right associativity, at level 30).

  Inductive arrowR : nat -> nat -> nat -> nat -> Prop :=
  | ArrowBaseN : forall a b,
      arrowR a 1 b (a ^ b)
  | ArrowBaseRhs : forall a n,
      arrowR a (S n) 0 1
  | ArrowInd : forall a b n x y,
      arrowR a (S n) b y ->
      arrowR a n y x ->
      arrowR a (S n) (S b) x.

  Notation "[ a ^{ n } b == x ]" := (arrowR a n b x) (at level 100).

  Lemma arrowR_0 : forall a b x,
      ~ [a ^{0} b == x].
  Proof.
    intros a b x E. inversion E.
  Qed.

  Proposition arrowR_eq_x : forall a n b x x',
      [a ^{n} b == x] -> [a ^{n} b == x'] -> x = x'.
  Proof.
    intros a n b x x' Ex Ex'.
    generalize dependent x'.
    induction Ex; intros x' Ex';
      inversion Ex'; subst; try reflexivity.
    - (* contradiction *)
      exfalso. eapply arrowR_0. apply H2.
    - exfalso. eapply arrowR_0. apply Ex2.
    - apply IHEx2. replace y with y0. assumption.
      symmetry. apply IHEx1. assumption.
  Qed.

  Proposition arrowR_exists_x : forall a n b,
      exists x, [a ^{S n} b == x].
  Proof.
    intros a n.
    induction n as [| n' IHn']; intros b.
    - exists (a ^ b). apply ArrowBaseN.
    - induction b as [| b' IHb'].
      + (* b = 0 *)
        exists 1. constructor.
      + (* b > 0 *)
        destruct IHb' as [y IHb'].
        specialize (IHn' y). destruct IHn' as [x IHn'].
        exists x. apply ArrowInd with y.
        assumption. assumption.
  Qed.

  Example tetration_arrowR2_equiv : forall a b,
      [a ^{2} b == a ^^ b].
  Proof.
    intros a b. induction b as [|b' IHb'].
    - (* b = 0 *)
      simpl. apply ArrowBaseRhs.
    - (* b > 0 *)
      inversion IHb'; subst.
      + simpl. eapply ArrowInd.
        apply ArrowBaseRhs. apply ArrowBaseN.
      + eapply ArrowInd.
        apply IHb'.
        apply ArrowBaseN.
  Qed.

End Beaf.


Require Import ssreflect.

(* Type *)
Check true.
Check 0.
Check 5.

(* functions *)

Parameter f : nat -> nat.
Check f.
Parameter g : nat -> nat -> nat.
Parameter g' : (nat -> nat) -> nat.
Check g'.
Check g.

Check (g 2). (* partial application *)
Check (g 2 3).

Parameter weirdo : nat -> bool -> nat.
Check (weirdo 5 false).

Check (g 2 (f 5)).

(* predefined addition *)
Check Nat.add.
Check (Nat.add 4 5).

(* defining a function : identity *)
Check (fun x : nat =>  x).

Definition d :=
  fun x : nat =>  x + x.
Check d.

(* a function over functions *)
Definition iter2 :=
  fun f : nat->nat =>
    fun x : nat =>  f (f x).
Check iter2.

(* Properties *)

Parameter even : nat -> Prop.
Check (even 5).

Lemma ex0 : (even 4)\/(even 5).
Abort.

Check (2 = 4).

Check  forall x : nat, x = 2.
Check  exists y : nat, y = 2.
Check forall x, x = 2.

(* quantifiers and proofs over quantifiers *)
Lemma ex1 : (forall x : nat, even x)
            ->
              (forall y : nat, even y).
  move => h.
move => z.
apply h.
Qed.

Parameter odd : nat -> Prop.

Parameter P Q : nat -> Prop.

Lemma ex11 : (forall x, P x) -> P 3.
Proof.
move => h.
apply h.
Qed.

Lemma ex2 : (forall x, P x) ->
                   (forall y, P y).
Proof.
  move => h.
  move => z.
  apply h.
Qed.

Lemma ex3 :
  (forall x, P x -> Q x) ->
    Q 4.
move => h.
apply h.
Abort.

Lemma hh : (forall x, P x) ->
                   exists x, P x.
Proof.
move => h.
exists 97. (* we can chose any number *)
apply h.
Qed.

Lemma last : (forall y, P y -> Q y) ->
             (exists x, P x) ->
             exists x, Q x.
Proof.
move => h1.
move => h2.
case h2 => [t pt].
exists t.
apply h1.
apply pt.
Qed.

(* Here R is the relation in mathematical meaning *)
Parameter R : nat -> nat -> Prop.

Axiom R_trans : forall x y z, R x y ->
                              R y z ->
                              R x z.

Lemma exR : R 1 2 -> R 2 3 -> R 1 3.
move => r12 r23.
apply R_trans with 2.
apply r12.
apply r23.
Qed.

Lemma sym : forall (x: nat) y,
    x = y ->
    y = x.
Proof.
move => x y xy.
rewrite xy.
reflexivity.
Qed.

Lemma refl : forall x : nat, x = x.
move => x.
reflexivity.
Qed.

Lemma trans : forall (x:nat) y z,
    x = y -> y = z -> x = z.
  move => x y z xy yz.
  rewrite xy yz. reflexivity.
  (*  rewrite -yz; exact xy. *)
Qed.

Lemma exx :
  (forall x, P x -> Q x) ->
  (forall y, Q y -> y = 5) ->
  ~P 5 ->
  forall z,  ~P z.
  move => h1 h2 h3.
  move => z.
  move => pz.
  apply h3.


Inductive natlist : Type :=
  | nil : natlist
  | cons : nat -> natlist -> natlist.

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

Fixpoint append(m n :natlist) : natlist :=
match m with
|[] => n
|a :: b => a::(append b n)
end.

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

Fixpoint snoc(m:natlist)(n:nat) :natlist:=
match m with
|[] => [n]
|a::b => a:: (snoc b n)
end.

Fixpoint reverse(n:natlist) : natlist :=
match n with
|[] => []
|a::b => snoc(reverse b) a
end.

Theorem associative_L3 : forall n o p : natlist, n++(o++p) = (n++o)++p.
Proof.
intros n o p.
induction n.
simpl. reflexivity.
simpl. rewrite -> IHn.
reflexivity.
Qed.

Theorem appendList : forall (list : natlist) (n : nat), snoc list n = list ++ [n].
Proof.
  intros.
    induction list as [| x xs].
    simpl.
    reflexivity.
    simpl.
    rewrite -> IHxs.
    reflexivity.
Qed.

Theorem appendEmptyList : forall list : natlist, list ++ [] = list.
Proof.
  intros.
    induction list as [| x xs].
    simpl.
    reflexivity.
    simpl.
    rewrite -> IHxs.
    reflexivity.
Qed.

Theorem reverseDistributive : forall l1 l2 : natlist, reverse (l1 ++ l2 ) = (reverse l2 ) ++ (reverse l1 ).
Proof.
intros l1 l2.
induction l1.
simpl. rewrite appendEmptyList.
simpl. reflexivity.
simpl. rewrite IHl1.
simpl. rewrite appendList.
simpl. rewrite appendList.
simpl. rewrite associative_L3.
reflexivity.
Qed.


(*
 * その6: https://www.fos.kuis.kyoto-u.ac.jp/~igarashi/class/cal/handout6.pdf
 * 論理演算の練習
 *)

Require Import Arith List Omega ZArith.
From mathcomp Require Import all_ssreflect.
Import ListNotations.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

(*
論理演算の練習
*)

Theorem ex_falso : forall P: Prop, False -> P.
Proof.
  intros P falso.
  destruct falso.
Qed.

Theorem double_neg : forall (P:Prop), P -> ~ ~P.
Proof.
  intros P HP.
  unfold not.
  intro HnotP.
  apply (HnotP HP).
Qed.

Theorem iff_sym : forall P Q: Prop, (P <-> Q) -> (Q <-> P).
Proof.
  intros P Q [PQ QP].
  split.
  - exact.
  - exact.
Qed.

Lemma mult_0 : forall n m, n * m = 0 <-> n = 0 \/ m = 0.
Proof.
  intros n m.
  split.
  - (* => *)
    case n as [|n'].
    + (* when n = 0 *)
      by left.
    + (* when n = S n' *)
      case m as [|m'].
      * (* when m = 0 *)
        by right.
      * (* when m = S m' *)
        discriminate.
  - (* <= *)
    case.
    + intro n_is_0.
      rewrite n_is_0.
      done.
    + intro m_is_0.
      rewrite m_is_0.
      done.
Qed.

Lemma mult_0_3 : forall n m p,
  n * m * p = 0 <-> n = 0 \/ m = 0 \/ p = 0.
Proof.
  intros n m p.
  rewrite !mult_0.
  by rewrite or_assoc.
Qed.

(*
exists の練習
*)

Theorem exists_ex2 : forall n,
  (exists m, n = 4 + m) -> (exists k, n = 2 + k).
Proof.
  intros n.
  intros H.
  destruct H.
  exists (2 + x).
  rewrite H.
  done.
Qed.

Axiom functional_extensionality :
  forall {X Y: Type} {f g : X -> Y},
  (forall (x : X), f x = g x) -> f = g.

Example function_equality_ex : (fun x => x + 1) = (fun x => 1 + x).
Proof.
  apply functional_extensionality.
  intro x.
  rewrite [x+1] addnC.
  done.
Qed.

(*
証明に用いた公理の確認
*)
Print Assumptions function_equality_ex.

(*
古典論理の話
*)

(* 排中律 *)
Definition ext_mid := forall P, P \/ ~P.

(*
 を仮定すると以下が成り立つ
 *)

Theorem Peirce_law : forall P Q : Prop,
  ext_mid -> ((P -> Q) -> P) -> P.
Proof.
  unfold ext_mid.
  intros P Q ExtMidLaw.
  move: (ExtMidLaw P).
  case.
  - (* when P *)
    done.
  - (* when not P *)
    move => HnotP H.
    apply H.
    move/HnotP.
    done.
Qed.

Theorem ClassicTheorem : ext_mid -> forall (P Q : Prop), (P -> Q) -> ~P \/ Q.
Proof.
  unfold ext_mid.
  intros ExtMidLaw P Q HPQ.
  move: (ExtMidLaw P).
  case.
  - (* when P *)
    move/HPQ.
    by right.
  - (* when not P *)
    by left.
Qed.


(**************************************************************************
* TLC: A library for Coq                                                  *
* Examples for other tactics provided by TLC                              *
**************************************************************************)

Set Implicit Arguments.
Require Import LibTactics.

(* ********************************************************************** *)
(** * How to do recursion/induction on terms with list of subterms *)

Module SubtermIndDemos.

Require Import LibLogic LibList.

(** Definition of trees with list of subtrees *)

Inductive tree : Type :=
  | leaf : nat -> tree
  | node : list tree -> tree.

(** Example of a primitive-recursive function on trees
    using an inlined fixed point -- not recommended *)

Fixpoint tree_incr' (t:tree) :=
  match t with
  | leaf n => leaf (S n)
  | node ts =>
     node ((fix aux ts := match ts with
            | nil => nil
            | t::ts' => tree_incr' t :: aux ts'
            end) ts)
  end.

(** Same example but using the map function on lists
    -- recommended
    -- this works only because List.map has exactly
    the same form as the local [fix] used above.
    -- if you wanted to use LibList.map instead of
    List.map, it would not work; you would have to
    either use the optimal fixed point (see LibFixDemos)
    or you would have to exploit [List.map = LibList.map] *)

Fixpoint tree_incr (t:tree) :=
  match t with
  | leaf n => leaf (S n)
  | node ts => node (List.map tree_incr ts)
  end.

(** Another example -- recommended *)

Fixpoint tree_map (f:nat->nat) (t:tree) :=
  match t with
  | leaf n => leaf (f n)
  | node ts => node (List.map (tree_map f) ts)
  end.

(** Another example using List.fold -- recommended *)

Fixpoint tree_sum (t:tree) :=
  match t with
  | leaf n => n
  | node ts => List.fold_left (fun acc t => acc + tree_sum t) ts 0
  end.

(** Proof of the recursion principle *)

Section Tree_induct.
(* Note: some hypotheses are given directly by [Check tree_ind] *)
Variables
(P : tree -> Prop)
(Q : list tree -> Prop)
(P1 : forall n, P (leaf n))
(P2 : forall ts, Q ts -> P (node ts))
(Q1 : Q nil)
(Q2 : forall t ts, P t -> Q ts -> Q (t::ts)).

Fixpoint tree_induct_gen (t : tree) : P t :=
  match t as x return P x with
  | leaf n => P1 n
  | node ts => P2
      ((fix tree_list_induct (ts:list tree) : Q ts :=
      match ts as x return Q x with
      | nil   => Q1
      | t::ts' => Q2 (tree_induct_gen t) (tree_list_induct ts')
      end) ts)
  end.

End Tree_induct.

(** Example of a direct inductive proof -- not recommended *)

Lemma tree_map_pred_succ_1 : forall t,
  tree_map pred (tree_map S t) = t.
Proof using.
  intros. pattern t. match goal with |- ?F _ => sets P: F end.
  eapply tree_induct_gen with (Q := Forall P); subst P; simpl; intros.
  fequals.
  fequals. induction ts; simpl.
    fequals.
    inverts H. fequals~.
  constructors.
  constructors~.
Qed.

(** Proof of the induction principle with Forall *)

Lemma tree_induct_forall : forall (P : tree -> Prop),
  (forall n : nat, P (leaf n)) ->
  (forall ts : list tree, Forall P ts -> P (node ts)) ->
  forall t : tree, P t.
Proof using.
  introv Hl Hn. eapply tree_induct_gen with (Q := Forall P); intros.
  auto. auto. constructors~. constructors~.
Qed.

(** Example of an inductive proof with Forall
    -- recommended *)

Lemma tree_map_pred_succ_2 : forall t,
  tree_map pred (tree_map S t) = t.
Proof using.
  intros. induction t using tree_induct_forall; simpl.
  fequals.
  fequals. induction ts; simpl.
    auto.
    inverts H. fequals~.
Qed.

(** Proof of the induction principle with Mem *)

Lemma tree_induct_mem : forall (P : tree -> Prop),
  (forall n : nat, P (leaf n)) ->
  (forall ts : list tree,
    (forall t, Mem t ts -> P t) -> P (node ts)) ->
  forall t : tree, P t.
Proof using.
  introv Hl Hn. eapply tree_induct_gen with (Q := fun ts =>
    forall t, Mem t ts -> P t); intros.
  auto. auto. inverts H. inverts~ H1.
Qed.

Hint Constructors Mem.

(** Example of an inductive proof with Mem
    -- usually not as good as the one with [Forall] *)

Lemma tree_map_pred_succ_3 : forall t,
  tree_map pred (tree_map S t) = t.
Proof using.
  intros. induction t using tree_induct_mem; simpl.
  fequals.
  fequals. induction ts; simpl.
    fequals.
    fequals.
      apply H. constructor.
      apply IHts. introv M. apply H. auto.
Qed.

(** Definition of the relation "immediate subtree of" *)

Require Import LibRelation LibWf.

Inductive subtree : binary tree :=
  | subtree_intro : forall t ts,
     Mem t ts -> subtree t (node ts).
  (* there is typically more than one case here *)

Hint Constructors subtree.

(** Proof of well-foundedness of the subtree relation *)

Lemma subtree_wf : wf subtree.
Proof using.
  intros t. induction t using tree_induct_mem;
  constructor; introv K; inversions~ K.
Qed.

(** Example of a proof on the well-founded subtree order
    -- usually a bit longer, so not recommended *)

Lemma tree_map_pred_succ_4 : forall t,
  tree_map pred (tree_map S t) = t.
Proof using.
  intros. induction_wf IH: subtree_wf t.
  destruct t as [|ts]; simpl.
  fequals.
  fequals. induction ts; simpl.
    fequals.
    fequals.
      applys IH. auto.
      applys IHts. introv M. inverts M.
       auto. (* apply IH. constructors. constructors. *)
Qed.

End SubtermIndDemos.

(* ********************************************************************** *)
(** * Tactics exported by LibVar *)

Module LibVarDemos.
Require Import LibList LibLN.
Section LibVarDemo.
Implicit Types x y : var.

(* ---------------------------------------------------------------------- *)
(** ** Demo for notin *)

Lemma test_notin_solve_1 : forall x E F G,
  x \notin E \u F -> x \notin G -> x \notin (E \u G).
Proof using.
  intros. dup.
  notin_simpl. notin_solve. notin_solve.
  notin_solve.
Qed.

Lemma test_notin_solve_2 : forall x y E F G,
  x \notin E \u \{y} \u F -> x \notin G ->
  x \notin \{y} /\ y \notin \{x}.
Proof using.
  split. notin_solve. notin_solve.
Qed.

Lemma test_notin_solve_3 : forall x y,
  x <> y -> x \notin \{y} /\ y \notin \{x}.
Proof using.
  split. notin_solve. notin_solve.
Qed.

Lemma test_notin_solve_4 : forall x y,
  x \notin \{y} -> x <> y /\ y <> x.
Proof using.
  split. notin_solve. notin_solve.
Qed.

Lemma test_notin_false_1 : forall x y E F G,
  x \notin (E \u \{x} \u F) -> y \notin G.
Proof using.
  intros. dup 3.
    false. notin_false.
    notin_false.
    notin_false.
Qed.

Lemma test_notin_false_2 : forall x y : var,
  x <> x -> y = x.
Proof using.
  intros. notin_false.
Qed.

Lemma test_neq_solve : forall x y E F,
  x \notin (E \u \{y} \u F) -> y \notin E ->
  y <> x /\ x <> y.
Proof using.
  split. notin_solve. notin_solve.
Qed.

(* ---------------------------------------------------------------------- *)
(** ** Demo for fresh *)

Lemma test_fresh_solve_1 : forall xs L1 L2 n,
  fresh (L1 \u L2) n xs -> fresh L1 n xs.
Proof using.
  intros. fresh_solve.
Qed.

Lemma test_fresh_solve_2 : forall xs L1 L2 n,
 fresh (L1 \u L2) n xs -> fresh L2 n xs.
Proof using.
  intros. fresh_solve.
Qed.

Lemma test_fresh_solve_3 : forall xs L1 L2 n,
 fresh (L1 \u L2) n xs -> fresh \{} n xs.
Proof using.
  intros. fresh_solve.
Qed.

Lemma test_fresh_solve_4 : forall xs L1 L2 n,
 fresh (L1 \u L2) n xs -> fresh L1 (length xs) xs.
Proof using.
  intros. fresh_solve.
Qed.

Lemma test_fresh_solve_5 : forall xs L1 n m,
  m = n ->
  fresh L1 m xs ->
  fresh L1 n xs.
Proof using.
  intros. fresh_solve.
Qed.

Lemma test_fresh_solve_6 : forall xs L1 L2 n m,
  m = n ->
  fresh (L1 \u L2) n xs ->
  fresh L1 m xs.
Proof using.
  intros. fresh_solve.
Qed.

Lemma test_fresh_solve_7 : forall xs L1 L2 n m,
  n = m ->
  fresh (L1 \u L2) n xs ->
  fresh L1 m xs.
Proof using.
  intros. fresh_solve.
Qed.

(* ---------------------------------------------------------------------- *)
(** ** Demo of automation of [notin] *)

(* LibVar exports the following hints:
     Hint Extern 1 (_ \notin _) => notin_solve.
     Hint Extern 1 (_ <> _ :> var) => notin_solve.
     Hint Extern 1 ((_ \notin _) /\ _) => splits. *)

Lemma test_notin_by_auto : forall x E F G,
  x \notin E \u F -> x \notin G -> x \notin (E \u G).
Proof using. auto. Qed.

Lemma test_neq_by_auto : forall x y E,
  x \notin E \u \{y} -> y <> x.
Proof using. auto. Qed.

Lemma test_notin_false_by_hand : forall x,
  ~ x \notin \{x}.
Proof using. intros_all. notin_false. Qed.

Hint Extern 1 (~ _ \notin _) => intros_all; notin_false.

Lemma test_notin_false_by_auto : forall x,
  ~ x \notin \{x}.
Proof using. intros_all. notin_false. Qed.

(* Comment: using the following hint is a bad idea because it will
            lead to very inefficient proof scripts.
   Hint Extern 1 (False) => notin_false. *)

(* ---------------------------------------------------------------------- *)
(** ** Demo of pick_fresh_gen *)

Parameter trm : Type.
Parameter fv : trm -> vars.

Ltac gather_vars :=
  let A := gather_vars_with (fun x : vars => x) in
  let B := gather_vars_with (fun x : var => \{x}) in
  let C := gather_vars_with (fun x : trm => fv x) in
  constr:(A \u B \u C).

Ltac pick_fresh Y :=
  let L := gather_vars in (pick_fresh_gen L Y).

Lemma test_pick_fresh :
  forall (x y z : var) (L1 L2 L3 : vars) (t1 t2 : trm), True.
Proof using.
  intros. pick_fresh a.
Abort.

End LibVarDemo.
End LibVarDemos.


(* Copyright (c) 2011, Thorsten Altenkirch *)

(** %\chapter{%#<H0>#Peano Arithmetic%}%#</H0># *)

Section Arith.

(** * The natural numbers *)

(** Guiseppe Peano defined the natural numbers as given by [0 : nat]
    and if [n] is a natural number then [S n : nat] is a natural number
    called the successor of [n]. Given this we can construct all the
    natural numbers, e.g.
    - 1 = S 0
    - 2 = S 1 = S (S 0)
    - 3 = S 2 = S (S (S 0))
    Moreover these are all natural numbers (we say they are defined _inductively_).

    Peano went on to represent the fundamental properties of the natural
    numbers using axioms. Some of the axioms express general properties of
    equality, which we have already seen. But the following three are
    specific to the natural numbers. Indeed, they are provable propositions
    in Coq:

    - Axiom 7 : 0 is not the successor of any number.
      [forall n:nat, S n <> 0]
    - Axiom 8 : If two numbers have the same successor, then they are equal.
      [forall m n:nat, S m = S n -> m = n ]
    - Axiom 9 : If any property holds for 0, and is closed under successor,
      then it holds
      for all natural numbers (principle of induction).
      [forall P : nat -> Prop, P 0
                      -> (forall m : nat, P m -> P (S m))
                      -> forall n : nat, P n]

    For illustration we are going to prove these principles:
*)

Lemma peano7 : forall n:nat, S n <> 0.
intro n.
intro h.

(** This is basically the same problem as proving [true <> false], we
    could apply the same technique here. To avoid repetetion we just
    use the [discriminate] tactic.
*)

discriminate h.
Qed.

(** To prove the next axiom, it is useful to define the inverse to
    S, the predecessor function pred. We arbitrarily decide that the
    predecessor of 0 is 0. *)

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

Lemma peano8 : forall m n:nat, S m = S n -> m = n.
intros m n h.

(** By folding with [pred] we can change the current goal so that we can
    apply our hypothesis. *)

fold (pred (S m)).
rewrite h.

(** And now we just have to unfold. simpl would have done the job too. *)

unfold pred.
reflexivity.
Qed.

(** The 8th axiom says that the successor function is injective.
    Can we prove the other direction too?
    [forall m n:nat, m = n -> S m = S n]
    Does this tell us anything new
    about the successor function? *)

(** The proof of the induction axiom is rather boring. It just uses a tactic
    which is called [induction]... *)

Lemma peano9 : forall P : nat -> Prop, P 0
                      -> (forall m : nat, P m -> P (S m))
                      -> forall n : nat, P n.
intros P h0 hS n.
induction n.
exact h0.
apply hS.
exact IHn.
Qed.

(** * Addition and multiplication *)

(** Peano defined the operations addition and multiplication.
    These are actually examples of functions defined by _primitive
    recursion_ a general scheme which can be used to define many
    other functions. A function is definable by primitive recursion
    if we can give a case for 0 and reduce the computation for the
    value at [S n] to the value at [n]. In Coq we have to use the
    keyword [fixpoint] instead of [definition] and we have to indicate
    on which argument we want to do primitive recursion.
*)

(** The idea is that we can define addition like this:
   - to add 0 to a number is just this number,
   - to add one more that n to a number is one more than adding
     n to the number.
*)

Fixpoint add (m n : nat) {struct m} : nat :=
  match m with
  | 0 => n
  | S m => S (add m n)
  end.

Eval compute in (add 2 3).

(** In the Coq library addition is defined using the usual infix
    notation [+]. *)

(** To define multiplication we use primitive recursion again. This time
    the idea is the following.
    - multiplying 0 with a number is just 0.
    - multiplying one more than n with a number is obtained by adding
      the number to multiplying n with the number.
*)

Fixpoint mult (m n : nat) {struct m} : nat :=
  match m with
  | 0 => 0
  | S m => add n (mult m n)
  end.

Eval compute in (mult 2 3).

(** In the Coq library addition is defined using the usual infix
    notation [+] and [*] with the usual rules of precedence.
    From now on we shall use the library versions which are defined
    exactly in the same way as we have defined [add] and [mult] *)

(** * Algebraic properties *)

(** Addition and multiplication satisfy a number of important equations:
   - 0 is a neutral element for addition
     [0 + m = m] and [m + 0 = m]
   - Addition is associative.
     [m + (n + l) = (m + l) + n]
   - Addition is commutative.
     [m + n = n + m]
   - 1 is a neutral element for multiplication
     [1 * m = m] and [m * 1 = m]
   - Multiplication is associative.
     [m * (n * l) = (m * n) * l]
   - Multiplication is commutative.
     [m * n = n * m]
   - 0 is a null for multiplication.
     [m * 0 = 0] and [0 * m = 0]
   - Addition distributes over multiplication.
     [m * (n + l) = m * n + m * l]
     and
     [(m + n) * l = m * l + n * l]

   In the language of universal algebra, we say that
   - (+,0) is a _commutative monoid_,
     because 0 is neutral, [+] is associative and commutative.
   - ( *,1) is a commutative monoid,
     because 1 is neutral, [*] is associative and commutative.
   - (+,0,*,1) is a _commutative semiring_ because
     (+,0) and ( *,1) are commutative monoids and
     [0] is a zero for multiplication and
     addition distributes over multiplication.

   We are going to prove that (+,0) is a commutative monoid
   and leave the remaining properties as an exercise. *)

Lemma plus_O_n : forall n:nat, n = 0 + n.
(** This property is very easy to prove.
    Can you see why?
*)
intro n.
reflexivity.
Qed.

Lemma plus_n_O : forall n:nat, n = n + 0.
intro n.

(** This one cannot be proven by reflexivity.
    So we have to use induction. *)

induction n.

(** n = 0
    This is easy. *)

simpl.
reflexivity.

(** We can simplify [S n + 0] using the definition of [+] *)

simpl.
rewrite<- IHn.
reflexivity.
Qed.

Lemma plus_assoc : forall (l m n:nat),l + (m + n) = (l + m) + n.
intros l m n.

(** There seems to be quite a choice what to do induction over:
    [l],[m],[n] but only one of them works. Why? *)

induction l.
simpl.
reflexivity.
simpl.
rewrite IHl.
reflexivity.
Qed.

(** To prove commutativity we first prove a lemma
    we know already that [0 + m = m = m + 0]
    but what about [S m + n = S (m + n) = m + S n] ?
*)

Lemma plus_n_Sm : forall n m : nat, S (m + n) = m + S n.
intros.
induction m.
simpl.
reflexivity.
simpl.
rewrite IHm.
reflexivity.
Qed.

(** We are now ready to prove commutativity. *)

Lemma plus_comm : forall n m:nat, n + m = m + n.
intros.
induction n.
simpl.
apply plus_n_O.
simpl.
rewrite IHn.
apply plus_n_Sm.
Qed.

(** * Ordering the numbers *)

(** We define the relation [<=] on natural numbers by saying
    that [m <= n] holds if there is a number [k] such that
    [m = k + n]. *)

Definition leq (m n : nat) : Prop :=
  exists k : nat, n = k + m.

Notation "m <= n" := (leq m n).

(** We verify some basic properties of [<=]:
    - [<=] is reflexive.
      [forall n:nat, n <= n]
    - [<=] is transitive.
      [forall l m n:nat, l <= m -> m <= n -> l <= n]
    - [<=] is antisymmetric.
      [forall l m : nat, l <= m -> m <= l -> m = l]

  Any relation which is reflexive, transitive and antisymmetric is a _partial order_.
  Here the word _partial_ is used to differentiate [<=] from a total order like [<].
  We verify the first two properties in Coq, but leave antisymmetry as an exercise.
*)

Lemma le_refl: forall n:nat,n <= n.
intro n.
exists 0.
reflexivity.
Qed.

Lemma le_trans : forall (l m n : nat), l <= m -> m <= n -> l <= n.
intros l m n lm mn.
destruct lm as [k klm].
destruct mn as [j jmn].
exists (j+k).
rewrite<- plus_assoc.
rewrite<- klm.
rewrite<- jmn.
reflexivity.
Qed.

(** * Decidable properties *)

(** We say a predicate is [P : A -> Prop] _decidable_ if we can define
    a boolean function [decP : A -> bool] which agrees with the predicate,
    i.e. [forall a:A, P a <-> decP a = true]. This also extends to relations
    in the obvious way.

    We show below that equality on natural numbers is decidable.
    Do you know any undecidable predicates?
    Is equality always decidable?
*)

(** First we define the _decision procedure_. In the case of equality this is quite obvious:
   we inspect both parameters, if they start with different constructors (i.e. 0 vs S) they are certainly
   not equal. If they are both [0] they are equal, and if they both start with [S] then we recursively
   compare the arguments. *)

Fixpoint eqnat (m n : nat) {struct m} : bool :=
  match m with
  | 0 => match n with
         | 0 => true
         | S n' => false
         end
  | S m' => match n with
            | 0 => false
            | S n' => eqnat m' n'
            end
  end.

(** Now we show both direction seperately. The [->] direction just boils down
   to showing that [eqnat] is reflexive. Why? *)

Lemma eqnat_refl : forall m : nat,  eqnat m m = true.
intro m.
induction m.
reflexivity.
simpl.
exact IHm.
Qed.

(** The other direction is more interesting and requires a _double induction_
   over [m] and [n]. *)

Lemma eqnat_compl : forall m n : nat, eqnat m n = true -> m = n.
intro m.
(** Here it would have been a mistake to do [intros m n]. Why? *)
(** m = 0 *)
induction m.
intro n.
induction n.
(** n = 0 *)
intro h.
reflexivity.
(** n = S n' *)
intro h.
simpl in h.
discriminate h.
(** m = S m' *)
intro n.
induction n.
(** n = 0 *)
intro h.
discriminate h.
(** n = S n' *)
intro h.
assert (h' : m = n).
apply IHm.
exact h.
rewrite h'.
reflexivity.
Qed.

(** Finally, we can prove the theorem that equality for natural numbers is decidable. *)

Theorem eqnat_dec : forall m n : nat, m = n <-> eqnat m n = true.
intros m n.
split.
intro h.
rewrite h.
apply eqnat_refl.
apply eqnat_compl.
Qed.

End Arith.