Require Import primRec cPair extEqualNat.

(** The famous Fibonacci function *)

(* begin snippet fibDef *)

Fixpoint fib (n:nat) : nat :=
  match n with
  | 0 => 1
  | 1 => 1
  | S ((S p) as q) => fib q + fib p
  end.

(* end snippet fibDef *)

Section Proof_of_FibIsPR.

  (** To do :  Some parts of this proof may be made more generic *)

  (** let us consider another definition of fib, as an application of
      [nat_rec]
   *)

  Let fib_step (p: nat * nat) := (fst p + snd p, fst p).

  Let fib_iter n p:= (nat_rec (fun _ => (nat*nat)%type)
                              p
                              (fun _ p => fib_step p)
                              n).
  Definition fib_alt n := snd (fib_iter n (1,1)).

  Compute fib_alt 10.

  (** The theory of primitive functions deals only with functions
    of type [naryFunc n].

   So, let us define a variant of [fib_alt]

   *)

  Let fib_step_cPair p := cPair (cPairPi1 p + cPairPi2 p)
                                (cPairPi1 p).

  Let fib_iter_cPair n p := nat_rec (fun _ => nat)
                                    p
                                    (fun _ p => fib_step_cPair p)
                                    n.

  Definition fibPR n := cPairPi2 (fib_iter_cPair n (cPair 1 1)).

  (** Let us prove that [fibPR] is PR *)

  Lemma fibPRIsPR: isPR 1 fibPR.
    unfold fibPR; apply compose1_1IsPR.
    - apply indIsPR.
      unfold fib_step_cPair; apply filter01IsPR.
      apply compose1_2IsPR.
      + apply compose1_1IsPR.
        * apply idIsPR.
        * apply compose1_2IsPR.
          --  apply cPairPi1IsPR.
          -- apply cPairPi2IsPR.
          -- apply plusIsPR.
      + apply cPairPi1IsPR.
      + apply cPairIsPR.
    - apply cPairPi2IsPR.
  Qed.

  (** Ok, but we must prove that [fibPR] is extensionaly equal to [fib] *)

  (** let us consider the following relation *)

  Definition inv (p: nat*nat) (c: nat) :=  c = cPair (fst p) (snd p).

  Lemma inv_Pi : forall p c, inv p c ->  snd p = cPairPi2 c.
  Proof.
    intros;  unfold inv in H;  subst; now rewrite cPairProjections2.
  Qed.

  Lemma L0: inv (1,1) (cPair 1 1).
  Proof. reflexivity. Qed.

  Lemma LS : forall p c,  inv p c -> inv (fib_step p) (fib_step_cPair c).
  Proof.
    destruct p as (a,b); intros.
    unfold inv in *. simpl fst  in *. simpl snd in *.
    unfold fib_step_cPair.
    subst;  now rewrite cPairProjections1, cPairProjections2.
  Qed.

  Lemma L1 : forall  p c,
      inv p c -> forall n,
        inv (fib_iter n p)
            (fib_iter_cPair n c).
  Proof.
    induction n.
    - cbn; assumption.
    - cbn; now  apply LS.
  Qed.

  Lemma L2 : extEqual 1 fib_alt fibPR.
  Proof.
    intro n; unfold fib_alt, fibPR.
    rewrite (inv_Pi _ _ (L1 _ _ L0 n ));  reflexivity.
  Qed.

  Lemma fib_altIsPR : isPR 1 fib_alt.
  Proof.
    destruct fibPRIsPR  as [x Hx]; exists x.
    apply extEqualTrans with fibPR; auto.
    apply extEqualSym, L2.
  Qed.

  (** It remains to prove that fib_alt is equivalent to the "classical" fib *)

  Lemma fib_OK0 : forall n,
      fib_iter n (1,1) = (fib (S n), fib n).
  Proof.
    induction n; simpl; auto.
    destruct n.
    -  cbn;  reflexivity.
    - rewrite IHn; unfold fib_step.
        simpl fst; simpl snd; auto.
  Qed.

  Lemma fib_alt_Ok : extEqual 1 fib fib_alt.
  Proof.
    intro n;  change (fib n) with (snd (fib (S n), fib n)).
    rewrite <- fib_OK0; reflexivity.
  Qed.

  Theorem fibIsPR : isPR 1 fib.
  Proof.
    destruct fib_altIsPR as [x Hx].
    exists x;  apply extEqualTrans with fib_alt; auto.
    apply extEqualSym, fib_alt_Ok.
  Qed.

End Proof_of_FibIsPR.

Compute fibPR 1.

Compute fibPR 2.

(** Too long !

Time Compute fibPR 3.
 *)


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

Check nil.
Check cons.

Check (cons nat 2 (cons nat 1 (nil nat))).

Fixpoint length (X: Type) (l: list X): nat :=
  match l with
    | nil => 0
    | cons h t => S (length X t)
  end.

Example test_length1:
  length nat (cons nat 1 (cons nat 2 (nil nat))) = 2.
Proof. reflexivity. Qed.
Example test_length2:
  length bool (cons bool true (nil bool)) = 1.
Proof. reflexivity. Qed.

Fixpoint app (X: Type) (l1 l2: list X): (list X) :=
  match l1 with
    | nil => l2
    | cons h t => cons X h (app X t l2)
  end.

Fixpoint snoc (X: Type) (l:list X) (v:X): list X :=
  match l with
    | nil => cons X v (nil X)
    | cons h t => cons X h (snoc X t v)
  end.

Fixpoint rev (X:Type) (l:list X): list X :=
  match l with
    | nil => nil X
    | cons h t => snoc X (rev X t) h
  end.

Example test_rev1: rev nat (cons nat 1 (cons nat 2 (nil nat)))
                   = (cons nat 2 (cons nat 1 (nil nat))).
Proof. reflexivity. Qed.
Example test_rev2:
  rev bool (nil bool) = nil bool.
Proof. reflexivity. Qed.

Fixpoint app' X l1 l2: list X :=
  match l1 with
    | nil => l2
    | cons h t => cons X h (app' X t l2)
  end.

Check app'.
Check app.

Fixpoint length' (X:Type) (l:list X): nat :=
  match l with
    | nil => 0
    | cons h t => S (length' _ t)
  end.

Implicit Arguments nil [[X]].
Implicit Arguments cons [[X]].
Implicit Arguments length [[X]].
Implicit Arguments app [[X]].
Implicit Arguments rev [[X]].
Implicit Arguments snoc [[X]].

Definition list123'' := cons 1 (cons 2 (cons 3 nil)).

Check (length list123'').

Fixpoint length'' {X:Type} (l:list X): nat :=
  match l with
    | nil => 0
    | cons h t => S (length'' t)
  end.

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

Definition list123''' := [1, 2, 3].

Fixpoint repeat (X: Type) (n: X) (count: nat): list X :=
  match count with
    | O        => nil
    | S count' => cons n (repeat X n count')
  end.

Example test_repeat1:
  repeat bool true 2 = cons true (cons true nil).
Proof. reflexivity. Qed.

Theorem nil_app: forall X: Type, forall l:list X,
                   app [] l = l.
Proof. reflexivity. Qed.

Theorem rev_snoc: forall X: Type,
                  forall v: X,
                  forall s: list X,
                    rev (snoc s v) = v :: (rev s).
Proof.
  intros X v s.
  induction s.
  + reflexivity.
  + simpl. rewrite IHs. reflexivity.
Qed.

Theorem snoc_with_append: forall X: Type,
                          forall l1 l2: list X,
                          forall v: X,
                            snoc (l1 ++ l2) v = l1 ++ (snoc l2 v).
Proof.
  intros X l1 l2 v.
  induction l1.
  + simpl. reflexivity.
  + simpl. rewrite IHl1. reflexivity.
Qed.

Inductive prod (X Y: Type): Type :=
  pair: X -> Y -> prod X Y.
Implicit Arguments pair [[X] [Y]].

Notation "( x , y )" := (pair x y).
Notation "X * Y" := (prod X Y): type_scope.

Definition fst {X Y: Type} (p : X * Y): X :=
  match p with (x, y) => x end.
Definition snd {X Y: Type} (p : X * Y): Y :=
  match p with (x, y) => y end.

Fixpoint combine {X Y: Type} (lx: list X) (ly: list Y): list (X*Y) :=
  match (lx, ly) with
    | ([], _) => []
    | (_, []) => []
    | (x::tx, y::ty) => (x, y) :: (combine tx ty)
  end.

Check @combine.
Eval simpl in (combine [1,2] [false,false,true,true]).

Inductive option (X:Type) :Type :=
| Some: X -> option X
| None: option X.

Implicit Arguments Some [[X]].
Implicit Arguments None [[X]].

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 ble_nat (n m : nat) : bool :=
  match n with
    | O => true
    | S n' => match m with
                | O => false
                | S m' => ble_nat n' m'
              end
  end.

Fixpoint index {X: Type} (n: nat)
         (l: list X): option X :=
  match l with
    | [] => None
    | a :: l' => if beq_nat n 0 then Some a else index (pred n) l'
  end.

Example test_index1: index 0 [4,5,6,7] = Some 4.
Proof. reflexivity. Qed.
Example test_index2: index 1 [[1],[2]] = Some [2].
Proof. reflexivity. Qed.
Example test_index3: index 2 [true] = None.
Proof. reflexivity. Qed.

Definition hd_opt {X: Type} (l: list X): option X :=
  match l with
    | [] => None
    | a::_ => Some a
  end.

Check @hd_opt.

Example test_hd_opt1: hd_opt [1,2] = Some 1.
Proof. reflexivity. Qed.
Example test_hd_opt2: hd_opt [[1],[2]] = Some [1].
Proof. reflexivity. Qed.

Definition doit3times {X: Type} (f:X->X) (n:X): X :=
  f (f (f n)).

Check @doit3times.

Definition minustwo (n: nat): nat := pred (pred n).

Example test_doit3times: doit3times minustwo 9 = 3.
Proof. reflexivity. Qed.

Check plus.
Definition plus3 := plus 3.
Check plus3.
Example test_plus3: plus3 4 = 7.
Proof. reflexivity. Qed.
Example test_plus3': doit3times plus3 0 = 9.
Proof. reflexivity. Qed.
Example test_plus3'': doit3times (plus 3) 0 = 9.
Proof. reflexivity. Qed.

Definition prod_curry {X Y Z: Type}
           (f: X * Y -> Z) (x: X) (y: Y): Z := f (x, y).
Definition prod_uncurry {X Y Z: Type}
           (f: X -> Y -> Z) (p: X * Y): Z :=
  f (fst p) (snd p).

Theorem uncurry_curry: forall (X Y Z: Type) (f: X -> Y -> Z) x y,
                         prod_curry (prod_uncurry f) x y = f x y.
Proof.
  intros X Y Z f x y.
  reflexivity.
Qed.

Theorem curry_uncurry: forall (X Y Z: Type) (f: (X * Y) -> Z) (p: X * Y),
                         prod_uncurry (prod_curry f) p = f p.
Proof.
  intros X Y Z f p.
  destruct p.
  reflexivity.
Qed.

Fixpoint filter {X:Type} (test: X -> bool) (l: list X): (list X) :=
  match l with
    | [] => []
    | h :: t => if test h then h :: (filter test t)
                else filter test t
  end.

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_filter1: filter evenb [1,2,3,4] = [2,4].
Proof. reflexivity. Qed.

Definition length_is_1 {X: Type} (l: list X): bool :=
  beq_nat (length l) 1.

Example test_filter2:
  filter length_is_1
         [[1, 2],[3],[4],[5,6,7],[],[8]]
  = [[3],[4],[8]].
Proof. reflexivity. Qed.

Definition countoddmembers' (l: list nat): nat :=
  length (filter oddb l).

Example test_countoddmembers'1: countoddmembers' [1,0,3,1,4,5] = 4.
Proof. reflexivity. Qed.
Example test_countoddmembers'2: countoddmembers' [0,2,4] = 0.
Proof. reflexivity. Qed.
Example test_countoddmembers'3: countoddmembers' nil = 0.
Proof. reflexivity. Qed.

Example test_anon_fun':
  doit3times (fun n => n * n) 2 = 256.
Proof. reflexivity. Qed.

Example test_filter2': filter (fun l => beq_nat (length l) 1)
                              [[1, 2],[3],[4],[5,6,7],[],[8]]
                       = [[3],[4],[8]].
Proof. reflexivity. Qed.

Definition partition  {X: Type} (f: X -> bool) (l: list X): list X * list X :=
  (filter f l, filter (fun x => negb (f x))  l).

Example test_partition1: partition oddb [1,2,3,4,5] = ([1,3,5], [2,4]).
Proof. reflexivity. Qed.
Example test_partition2: partition (fun x => false) [5,9,0] = ([], [5,9,0]).
Proof. reflexivity. Qed.

Fixpoint map {X Y: Type} (f: X -> Y) (l: list X): (list Y) :=
  match l with
    | [] => []
    | h :: t => (f h) :: (map f t)
  end.

Example test_map1: map (plus 3) [2, 0, 2] = [5, 3, 5].
Proof. reflexivity. Qed.

Example test_map2: map oddb [2,1,2,5] = [false,true,false,true].
Proof. reflexivity. Qed.
Example test_map3:
  map (fun n => [evenb n, oddb n]) [2,1,2,5]
  = [[true,false],[false,true],[true,false],[false,true]].
Proof. reflexivity. Qed.

Theorem map_rev: forall (X Y: Type) (f: X -> Y) (l: list X),
                   map f (rev l) = rev (map f l).
Proof.
  intros X Y f l.
  induction l.
  + reflexivity.
  + Lemma snoc_map: forall (X Y: Type) (f: X -> Y) (l: list X) (x: X),
                      map f (snoc l x) = snoc (map f l) (f x).
    Proof.
      intros X Y f l x.
      induction l.
      + reflexivity.
      + simpl. rewrite IHl. reflexivity.
    Qed.
    simpl.
    rewrite snoc_map.
    rewrite IHl.
    reflexivity.
Qed.

Fixpoint flat_map {X Y: Type} (f:X -> list Y) (l:list X): (list Y) :=
  match l with
    | nil   => nil
    | a::l' => (f a) ++ (flat_map f l')
  end.

Example test_flat_map1:
  flat_map (fun n => [n,n,n]) [1,5,4] = [1,1,1,5,5,5,4,4,4].
Proof. reflexivity. Qed.

Definition option_map {X Y: Type} (f: X -> Y) (xo: option X) : option Y :=
  match xo with
    | None => None
    | Some x => Some (f x)
  end.

Fixpoint fold {X Y:Type} (f: X -> Y -> Y) (l:list X) (b:Y): Y :=
  match l with
    | nil => b
    | h :: t => f h (fold f t b)
  end.

Definition constfun {X: Type} (x: X): nat -> X :=
  fun (k:nat) => x.

Definition ftrue := constfun true.
Example constfun_example1: ftrue 0 = true.
Proof. reflexivity. Qed.
Example constfun_example: (constfun 5) 99 = 5.
Proof. reflexivity. Qed.

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

Definition fmostlytrue := override (override ftrue 1 false) 3 false.

Example override_example1: fmostlytrue 0 = true.
Proof. reflexivity. Qed.
Example override_example2: fmostlytrue 1 = false.
Proof. reflexivity. Qed.

Theorem override_example: forall (b: bool),
                            (override (constfun b) 3 true) 2 = b.
Proof. reflexivity. Qed.

Theorem unfold_examle_bad: forall m n,
                             3 + n = m -> plus3 n + 1 = m + 1.
Proof.
  intros m n H.
  unfold plus3.
  rewrite H.
  reflexivity.
Qed.

Theorem override_eq: forall {X: Type} x k (f:nat -> X),
                       (override f k x) k = x.
Proof.
  intros X x k f.
  unfold override.
  Lemma beq_nat_refl: forall (n: nat), beq_nat n n = true.
  Proof. intros n. induction n.
         + reflexivity.
         + simpl. apply IHn.
  Qed.
  simpl.
  rewrite beq_nat_refl.
  reflexivity.
Qed.

Theorem override_neq: forall {X: Type} x1 x2 k1 k2 (f: nat -> X),
                        f k1 = x1 ->
                        beq_nat k2 k1 = false ->
                        (override f k2 x2) k1 = x1.
Proof.
  intros X x1 x2 k1 k2 f.
  intros H.
  unfold override.
  intros I.
  rewrite I.
  rewrite H.
  reflexivity.
Qed.

Theorem eq_add_S: forall (n m : nat),
                    S n = S m -> n = m.
Proof.
  intros n m eq.
  inversion eq.
  reflexivity.
Qed.

Theorem silly4: forall (n m: nat),
                  [n] = [m] -> n = m.
Proof. intros n m eq. inversion eq. reflexivity. Qed.

Theorem silly5: forall (n m o: nat),
                  [n, m] = [o, o] ->
                  [n] = [m].
Proof.
  intros n m o eq.
  inversion eq.
  reflexivity.
Qed.

Example sillyex1: forall (X: Type) (x y z: X) (l j: list X),
                    x :: y :: l  = z :: j ->
                    y :: l = x :: j ->
                    x = y.
Proof.
  intros X x y z l j.
  intros eq1.
  intros eq2.
  inversion eq2.
  reflexivity.
Qed.

Theorem silly6: forall(n: nat),
                  S n = 0 ->
                  2 + 2 = 0.
Proof.
  intros n  contra. inversion contra. Qed.

Lemma eq_remove_S: forall n m,
                     n = m -> S n = S m.
Proof.
  intros n m.
  intros eq.
  inversion eq.
  reflexivity.
Qed.

Theorem beq_nat_eq: forall n m,
                      true = beq_nat n m -> n = m.
Proof.
  intros n.
  induction n as [| n'].
  + intros m. destruct m as [| m'].
  - reflexivity.
  - simpl. intros contra. inversion contra.
    + intros m. destruct m as [| m'].
  - simpl. intros contra. inversion contra.
  - simpl. intros H. apply eq_remove_S. apply IHn'. apply H.
Qed.

Theorem beq_nat_eq': forall n m,
                       beq_nat n m = true -> n = m.
Proof.
  intros m. induction m.
  + intros n.
    induction n. simpl. reflexivity.
    simpl. intros contra. inversion contra.
  + intros n.
    destruct n. simpl. intros contra. inversion contra.
    simpl. intros H. apply eq_remove_S. apply IHm. apply H.
Qed.

Theorem length_snoc': forall (X: Type) (v: X)
                             (l: list X) (n: nat),
                        length l = n ->
                        length (snoc l v) = S n.
Proof.
  intros X v l. induction l.
  + intros n eq. rewrite <- eq. reflexivity.
  + intros n eq. simpl. destruct n.
  - inversion eq.
  - apply eq_remove_S. apply IHl. inversion eq. reflexivity.
Qed.

Theorem beq_nat_0_l: forall n,
                       true = beq_nat 0 n -> 0 = n.
Proof.
  intros n H. induction n.
  + reflexivity.
  + inversion H.
Qed.

Theorem beq_nat_0_r: forall n,
                       true = beq_nat n 0 -> 0 = n.
Proof.
  intros n H. induction n.
  + reflexivity.
  + inversion H.
Qed.

Theorem S_inj: forall (n m: nat) (b: bool),
                 beq_nat (S n) (S m) = b ->
                 beq_nat n m = b.
Proof.
  intros n m b H. simpl in H. apply H. Qed.

Theorem silly3': forall (n: nat),
                   (beq_nat n 5 = true -> beq_nat (S (S n)) 7 = true) ->
                   true = beq_nat n 5 -> true = beq_nat (S (S n)) 7.
Proof.
  intros n eq H.
  symmetry in H. apply eq in H. symmetry in H. apply H.
Qed.

Definition sillyfun (n: nat): bool :=
  if beq_nat n 3 then false
  else if beq_nat n 5 then false
       else false.

Theorem sillyfun_false: forall (n: nat),
                          sillyfun n = false.
Proof.
  intros n. unfold sillyfun.
  destruct (beq_nat n 3).
  + reflexivity.
  + destruct (beq_nat n 5).
    reflexivity.
    reflexivity.
Qed.

Theorem override_shadow: forall {X:Type} x1 x2 k1 k2 (f: nat -> X),
                           (override (override f k1 x2) k1 x1) k2 = (override f k1 x1) k2.
Proof.
  intros X x1 x2 k1 k2 f.
  unfold override.
  destruct (beq_nat k1 k2).
  + reflexivity.
  + reflexivity.
Qed.

Example trans_eq_example: forall (a b c d e f: nat),
                            [a,b] = [c,d] ->
                            [c,d] = [e,f] ->
                            [a,b] = [e,f].
Proof.
  intros a b c d e f eq1 eq2.
  rewrite -> eq1. rewrite -> eq2. reflexivity.
Qed.

Definition fold_length {X: Type} (l: list X): nat :=
  fold (fun _ n => S n) l 0.

Example test_fold_length1: fold_length [4,7,0] = 3.
Proof. reflexivity. Qed.

Theorem fold_length_correct: forall X (l: list X),
                               fold_length l = length l.
Proof.
  intros X l.
  induction l.
  + simpl. unfold fold_length. simpl. reflexivity.
  + simpl. unfold fold_length. simpl. unfold fold_length in IHl.
    apply eq_remove_S. apply IHl.
Qed.

Theorem plus_n_n_injective: forall n m,
                              n + n = m + m -> n = m.
Proof.
  intros n. induction n.
  + simpl. intros m. induction m.
  -reflexivity.
  - intros H. inversion H.
    + intros m. induction m.
  -  intros H. simpl in H. inversion H.
  - intros H.
    apply eq_remove_S. apply IHn.
    simpl in H. apply eq_add_S in H.

    Lemma plus_succ: forall (n m: nat),
                       n + S m = S (n + m).
    Proof.
      intros n. induction n.
      + intros m. simpl.  reflexivity.
      + intros m. simpl.
        apply eq_remove_S.
        apply IHn.
    Qed.
    Lemma plus_succ2: forall (n m: nat),
                        n + S n = m + S m -> n + n = m + m.
    Proof.
      intros n. induction n.
      + intros m H. simpl.
        simpl in H.
        rewrite plus_succ in H.
        apply eq_add_S.
        apply H.
      + intros m H.
        rewrite plus_succ in H.
        rewrite plus_succ in H.
        rewrite plus_succ in H.
        apply eq_add_S in H.
        simpl.
        rewrite plus_succ.
        apply H.
    Qed.
    simpl.
    rewrite plus_succ in H.
    rewrite plus_succ in H.
    apply eq_add_S in H.
    apply H.
Qed.

Theorem plus_n_n_injective_take2: forall n m,
                                    n + n = m + m ->
                                    n = m.
Proof.
  intros n m.
  generalize dependent n.
  induction m.
  + intros n H. induction n.
  - reflexivity.
  - simpl in H. simpl in IHn. inversion H.
    + intros n H. induction n.
  - inversion H.
  - simpl in H.
    apply eq_add_S in H.
    rewrite plus_succ in H.
    rewrite plus_succ in H.
    apply eq_add_S in H.
    apply IHm in H.
    rewrite H. reflexivity.
Qed.

Theorem index_afetr_last: forall (n: nat) (X: Type) (l: list X),
                            length l = n -> index (S n) l = None.
Proof.
  intros n X l.
  generalize dependent n.
  generalize dependent X.
  induction l.
  +  reflexivity.
  +  intros n H.
     simpl. destruct l.
     - unfold length in H. rewrite <- H.
     unfold index.
     reflexivity.
     - destruct n.
       inversion H.
       apply IHl.
       inversion H.
       induction l.
       simpl. reflexivity.
       simpl. reflexivity.
Qed.

Theorem length_snoc_''': forall (n: nat) (X: Type) (v: X) (l: list X),
                           length l = n -> length (snoc l v) = S n.
Proof.
  intros n X v l.
  generalize dependent n.
  generalize dependent v.
  induction l.
  + intros v n H.
    simpl.
    simpl in H.
    rewrite H.
    reflexivity.
  + intros v n H.
    simpl.
    destruct n.
  - inversion H.
  - apply eq_remove_S.
    apply IHl.
    inversion H.
    reflexivity.
Qed.

Theorem app_length_cons: forall(X: Type) (l1 l2: list X) (x: X) (n: nat),
                           length (l1 ++ (x :: l2)) = n ->
                           S (length (l1 ++ l2)) = n.
Proof.
  intros X l1. induction l1.
  + simpl. intros l2 x n H.
    apply H.
  + simpl. intros l2 x' n H.
    destruct n.
  - inversion H.
  - apply eq_add_S in H.
    apply IHl1 in H.
    apply eq_remove_S.
    apply H.
Qed.


(** * Computing the next power of 2. *)

(** Apparently there is a Nat.log2_up function that probably obviates
    the need for most of the things in this file. *)

From Coq Require Import
  Nat
  PeanoNat
  Arith
  Lia
.

Definition is_power_of_2 (n : nat) : Prop := exists m, 2^m = n.

Definition is_power_of_2b (n : nat) := n =? 2 ^ log2 n.

Lemma is_power_of_2b_spec (n : nat)
  : Bool.reflect (is_power_of_2 n) (is_power_of_2b n).
Proof.
  destruct (is_power_of_2b n) eqn:H; constructor.
  - unfold is_power_of_2b in H; apply Nat.eqb_eq in H.
    exists (log2 n); auto.
  - apply Nat.eqb_neq in H.
    intro Contra; apply H.
    destruct Contra as [m Contra].
    subst; rewrite Nat.log2_pow2; lia.
Qed.

(** The function *)
Definition next_pow_2 (n : nat) :=
  if n =? 0 then 1 else if is_power_of_2b n then n else 2 ^ S (log2 n).

Lemma not_pow_2_le_lt (n m : nat) : ~ is_power_of_2 n -> n <= 2^m -> n < 2^m.
Proof.
  intros H0 H1; unfold is_power_of_2 in H0.
  assert (forall k, 2 ^ k <> n).
  { intros k HC. apply H0. exists k; auto. }
  specialize (H m);  lia.
Qed.

Lemma pow_2_lt_le (a b : nat) : 2^a < 2^b -> 2*2^a <= 2^b.
Proof.
  intro H.
  assert (H0: 2 * 2^a = 2 ^ (S a)). auto.
  rewrite H0. clear H0.
  assert (a < b).
  { rewrite Nat.pow_lt_mono_r_iff; eauto. }
  unfold lt in H0.
  apply Nat.pow_le_mono_r; auto.
Qed.

Lemma pow_positive (n k : nat) :
  0 < n ->
  0 < pow n k.
Proof.
  revert n; induction k; simpl; intros n Hlt; try lia.
  specialize (IHk n Hlt); lia.
Qed.

(** Specification and proof. *)
Lemma next_pow_2_spec (n : nat) :
  is_power_of_2 (next_pow_2 n) /\
    n <= next_pow_2 n /\
    forall m, n <= 2^m -> next_pow_2 n <= 2^m.
Proof.
  split.
  - unfold next_pow_2. destruct n; simpl.
    + exists 0; auto.
    + destruct (is_power_of_2b_spec (S n)); auto.
      rewrite Nat.add_0_r.
      exists (S (log2 (S n))); simpl; auto.
  - split.
    + unfold next_pow_2.
      destruct n; simpl; auto.
      destruct (is_power_of_2b_spec (S n)); auto.
      generalize (Nat.log2_spec (S n) (Nat.lt_0_succ n)). intros [_ H0].
      simpl in H0; lia.
    + intros m Hm; unfold next_pow_2.
      destruct n; simpl.
      * clear Hm; induction m; auto; simpl; lia.
      * destruct (is_power_of_2b_spec (S n)); auto.
        generalize (Nat.log2_spec (S n) (Nat.lt_0_succ n)). intros [H0 H1].
        rewrite Nat.add_0_r.
        apply not_pow_2_le_lt with (m:=m) in n0; auto.
        assert (H2: 2 ^ log2 (S n) < 2^m). lia.
        apply pow_2_lt_le in H2; lia.
Qed.

(** Immediate corollaries / helpers. *)

Lemma is_power_of_2_next_pow_2 (n : nat) :
  is_power_of_2 (next_pow_2 n).
Proof. apply next_pow_2_spec. Qed.

Lemma next_pow_2_ub (n : nat) :
  n <= next_pow_2 n.
Proof. apply next_pow_2_spec. Qed.

Lemma next_pow_2_positive (n : nat) :
  0 < next_pow_2 n.
Proof.
  generalize (is_power_of_2_next_pow_2 n); intros [k H].
  rewrite <- H.
  apply pow_positive; lia.
Qed.


Require Import Arith.

Fixpoint sum_odd(n:nat):nat :=
match n with
|O=>O
|S m => 1 + m + m + sum_odd m
end.

Goal forall n, sum_odd n = n*n.
Proof.
intros.
induction n.
simpl.
reflexivity.
simpl.
rewrite -> IHn.
replace (n+n*S n) with (n + n + n*n).
reflexivity.
rewrite <- plus_assoc.
apply NPeano.Nat.add_cancel_l.
replace (S n) with (n + 1).
rewrite -> mult_plus_distr_l.
rewrite -> mult_1_r.
apply (plus_comm n (n*n)).
apply (NPeano.Nat.add_1_r n).
Qed.


(* The subsequence relation is a partial order. *)

Require Import List.
Require Import Omega.
Import ListNotations.

Section subseq_sect.

  Variable A: Type.

  Inductive subseq: list A -> list A -> Prop :=
  | subseq_nil: subseq [] []
  | subseq_add: forall x ys zs, subseq ys zs -> subseq (x::ys) (x::zs)
  | subseq_sub: forall x ys zs, subseq ys zs -> subseq ys (x::zs).

  Hint Constructors subseq.

  Lemma subseq_refl:
    forall xs, subseq xs xs.
  Proof.
  Qed.

  Lemma subseq_len:
    forall xs ys, subseq xs ys -> length xs <= length ys.
  Proof.
  Qed.

  Lemma subseq_trans:
    forall ys zs, subseq ys zs -> forall xs, subseq xs ys -> subseq xs zs.
  Proof.
  Qed.

  (* Hint: use subseq_len to dispose of nonsense cases. *)
  Lemma subseq_antisym:
    forall xs ys, subseq xs ys -> subseq ys xs -> xs = ys.
  Proof.
  Qed.

End subseq_sect.


(*
Coq in a Hurry
Yves Bertot
*)

Check True.

Check true.

Eval compute in
  let f := fun x => (x * 3, x) in f 3.

Definition sum5 (a b c d e : nat) : nat := a+b+c+d+e.

Eval compute in sum5 1 2 3 4 5.

Check sum5.
Print sum5.

Definition example1 := fun x : nat => x*x+2*x+1.

Reset example1.

Definition example1 (x : nat) : nat := x*x+2*x+1.

Eval compute in example1 1.

Require Import Bool.

Eval compute in (if true then 4 else 5).

Require Import Arith.

Definition is_zero (n : nat) : bool :=
  match n with
  | O   => true
  | S p => false
  end.

Eval compute in (is_zero 1).

Fixpoint sum_n (n : nat) : nat :=
  match n with
  | O   => O
  | S p => (S p) + sum_n p
 end.

Eval compute in sum_n 4.

Fixpoint sum_n2 (n s : nat) :=
  match n with
  | O   => s
  | S p => sum_n2 p (p + s)
  end.

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

Require Import List.

Check 1::2::3::nil.

Fixpoint n_numbers (n : nat) : list nat :=
  match n with
  | O   => nil
  | S p => (n_numbers p) ++ (p::nil)
 end.

Eval compute in n_numbers 2.

Fixpoint n_numbers' (n : nat) : list nat :=
  match n with
  | O   => nil
  | S p => map (fun x => x) ((n_numbers' p) ++ (p::nil))
 end.

Eval compute in n_numbers' 5.

Definition head_evb (l: list nat) : bool :=
  match l with
  | nil   => false
  | a::tl => evenb a
  end.

Fixpoint sum_list (l : list nat) :=
  match l with
  | nil   => O
  | n::tl => n + (sum_list tl)
  end.

Fixpoint insert (n : nat) (l : list nat) : list nat :=
  match l with
  | nil   => n :: nil
  | a::tl => if leb n a then (n::l) else (a::insert n tl)
  end.

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

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

Definition get_head (A : Type) (r : A) (l : list A) : A :=
  match l with
  | nil => r
  | a::tl => a
  end.

Definition get_tail (A : Type) (l : list A) : list A :=
  match l with
  | nil => nil
  | a::tl => tl
  end.

Fixpoint is_sorted (l : list nat) : bool :=
  match l with
  | nil      => true
  | a::nil   => true
  | a::tl => if leb a (get_head nat 0 tl) then (is_sorted tl) else false
  end.

Eval compute in is_sorted (0::0::nil).

Fixpoint count_n (n : nat) (l : list nat) : nat :=
  match l with
  | nil   => O
  | a::tl => if (beq_nat a n) then (S (count_n n tl)) else (count_n n tl)
  end.

Eval compute in count_n 0 (0::0::nil).

Search True.

SearchPattern (_ + _ <= _ + _).

SearchAbout leb.

Lemma example2 : forall a b:Prop, a /\ b -> b /\ a.
Proof.
  intros.
  elim H; auto.
Qed.

Lemma example3 : forall A B, A \/ B -> B \/ A.
Proof.
  intros.
  elim H; auto.
Qed.

Lemma test1 : forall A B C:Prop, A/\(B/\C)->(A/\B)/\C.
Proof.
  intros.
  destruct H as [H1 H2].
  destruct H2 as [H2 H3].
  auto.
Qed.

Lemma test2 : forall A B C D: Prop,(A->B)/\(C->D)/\A/\C -> B/\D.
Proof.
  intros.
  destruct H as [H1 H2].
  destruct H2 as [H2 H3].
  destruct H3 as [H3 H4].
  split; auto.
Qed.

Lemma test3 : forall A: Prop, ~(A/\~A).
Proof.
  intros.
  unfold not.
  intros.
  destruct H as [H1 H2].
  apply H2. apply H1.
Qed.

Lemma test4 : forall A B C: Prop, A\/(B\/C)->(A\/B)\/C.
Proof.
  intros.
  destruct H; auto.
  destruct H; auto.
Qed.

Lemma test5 : forall A B: Prop, (A\/B)/\~A -> B.
Proof.
  intros.
  destruct H as [H1 H2].
  destruct H1; auto.
  contradiction.
Qed.

Lemma exercise_universal_quantification : forall A:Type, forall P Q: A->Prop,
(forall x, P x)\/(forall y, Q y)->forall x, P x\/Q x.
Proof.
  intros.
  destruct H.
  left. apply H.
  right. apply H.
Qed.

Lemma sum_n_p : forall n, 2 * sum_n n + n = n * n.
Proof.
  induction n.
  simpl. reflexivity.
  simpl in IHn.
Admitted.


(** * Lists: Working with Structured Data *)

(* $Date: 2012-09-08 20:51:57 -0400 (Sat, 08 Sep 2012) $ *)

(** The next line imports all of our definitions from the
    previous chapter. *)

Require Export Basics.

(** For it to work, you need to use [coqc] to compile [Basics.v]
    into [Basics.vo].  (This is like making a .class file from a .java
    file, or a .o file from a .c file.)

    Here are two ways to compile your code:

     - CoqIDE:

         Open [Basics.v].
         In the "Compile" menu, click on "Compile Buffer".

     - Command line:

         Run [coqc Basics.v]

    In this file, we again use the [Module] feature to wrap all of the
    definitions for pairs and lists of numbers in a module so that,
    later, we can reuse the same names for improved (generic) versions
    of the same operations. *)

Module NatList.

(* ###################################################### *)
(** * Pairs of Numbers *)

(** In an [Inductive] type definition, each constructor can take
    any number of parameters -- none (as with [true] and [O]), one (as
    with [S]), or more than one, as in this definition: *)

Inductive natprod : Type :=
  pair : nat -> nat -> natprod.

(** This declaration can be read: "There is just one way to
    construct a pair of numbers: by applying the constructor [pair] to
    two arguments of type [nat]." *)

(** We can construct an element of [natprod] like this: *)

Eval simpl in (pair 3 5).
(** Here are two simple function definitions for extracting the
    first and second components of a pair.  (The definitions also
    illustrate how to do pattern matching on two-argument
    constructors.) *)

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.

Eval simpl in (fst (pair 3 5)).

(** Since pairs are used quite a bit, it is nice to be able to
    write them with the standard mathematical notation [(x,y)] instead
    of [pair x y].  We can tell Coq to allow this with a [Notation]
    declaration. *)

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

(** The new notation can be used both in expressions and in
    pattern matches (indeed, we've seen it already in the previous
    chapter -- this notation is provided as part of the standard
    library): *)

Eval simpl in (fst (3,5)).

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.

(** Let's try and prove a few simple facts about pairs.  If we
    state the lemmas in a particular (and slightly peculiar) way, we
    can prove them with just reflexivity (and its built-in
    simplification): *)

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

(** But reflexivity is not enough if we state the lemma in a more
    natural way: *)

Theorem surjective_pairing_stuck : forall (p : natprod),
  p = (fst p, snd p).
Proof.
  simpl. (* Doesn't reduce anything! *)
Admitted.

(** We have to expose the structure of [p] so that [simpl] can
    perform the pattern match in [fst] and [snd].  We can do this with
    [destruct].

    Notice that, unlike for [nat]s, [destruct] doesn't generate an
    extra subgoal here.  That's because [natprod]s can only be
    constructed in one way.  *)

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

(** Notice that Coq allows us to use the notation we introduced
    for pairs in the "[as]..." pattern that tells it what variables to
    bind. *)

(** **** Exercise: 1 star (snd_fst_is_swap) *)
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.
  (* FILL IN HERE *)
(** [] *)

(** **** Exercise: 1 star, optional (fst_swap_is_snd) *)
Theorem fst_swap_is_snd : forall (p : natprod),
  fst (swap_pair p) = snd p.
Proof.
  (* FILL IN HERE *)
  intros p. destruct p as (n, m).
  simpl. reflexivity. Qed.
(** [] *)

(* ###################################################### *)
(** * Lists of Numbers *)

(** Generalizing the definition of pairs a little, we can
    describe the type of _lists_ of numbers like this: "A list is
    either the empty list or else a pair of a number and another
    list." *)

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

(** For example, here is a three-element list: *)

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

(** As with pairs, it is more convenient to write lists in
    familiar programming notation.  The following two declarations
    allow us to use [::] as an infix [cons] operator and square
    brackets as an "outfix" notation for constructing lists. *)

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

(** It is not necessary to fully understand these declarations,
    but in case you are interested, here is roughly what's going on.

    The [right associativity] annotation tells Coq how to parenthesize
    expressions involving several uses of [::] so that, for example,
    the next three declarations mean exactly the same thing: *)

Definition mylist1 := 1 :: (2 :: (3 :: nil)).
Definition mylist2 := 1 :: 2 :: 3 :: nil.
Definition mylist3 := [1,2,3].

(** The [at level 60] part tells Coq how to parenthesize
    expressions that involve both [::] and some other infix operator.
    For example, since we defined [+] as infix notation for the [plus]
    function at level 50,
Notation "x + y" := (plus x y)
                    (at level 50, left associativity).
   The [+] operator will bind tighter than [::], so [1 + 2 :: [3]]
   will be parsed, as we'd expect, as [(1 + 2) :: [3]] rather than [1
   + (2 :: [3])].

   (By the way, it's worth noting in passing that expressions like "[1
   + 2 :: [3]]" can be a little confusing when you read them in a .v
   file.  The inner brackets, around 3, indicate a list, but the outer
   brackets are there to instruct the "coqdoc" tool that the bracketed
   part should be displayed as Coq code rather than running text.
   These brackets don't appear in the generated HTML.)

   The second and third [Notation] declarations above introduce the
   standard square-bracket notation for lists; the right-hand side of
   the third one illustrates Coq's syntax for declaring n-ary
   notations and translating them to nested sequences of binary
   constructors. *)

(** A number of functions are useful for manipulating lists.
    For example, the [repeat] function takes a number [n] and a
    [count] and returns a list of length [count] where every element
    is [n]. *)

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

(** The [length] function calculates the length of a list. *)

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

(** The [app] ("append") function concatenates two lists. *)

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

(** Actually, [app] will be used a lot in some parts of what
    follows, so it is convenient to have an infix operator for it. *)

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

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

(** Here are two smaller examples of programming with lists.
    The [hd] function returns the first element (the "head") of the
    list, while [tail] returns everything but the first
    element.  Of course, the empty list has no first element, so we
    must pass a default value to be returned in that case.  *)

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

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

Example test_hd1:             hd 0 [1,2,3] = 1.
Proof. reflexivity.  Qed.
Example test_hd2:             hd 0 [] = 0.
Proof. reflexivity.  Qed.
Example test_tail:            tail [1,2,3] = [2,3].
Proof. reflexivity.  Qed.

(** **** Exercise: 2 stars, recommended (list_funs) *)
(** Complete the definitions of [nonzeros], [oddmembers] and
    [countoddmembers] below.  *)

Fixpoint nonzeros (l:natlist) : natlist :=
  (* FILL IN HERE *)
  match l with
    | nil => nil
    | h :: t => match h with
                  | 0 => nonzeros t
                  | n => [n] ++ nonzeros t
                end
  end.
Example test_nonzeros:            nonzeros [0,1,0,2,3,0,0] = [1,2,3].
 (* FILL IN HERE *)
Proof. reflexivity. Qed.

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

Example test_oddmembers:            oddmembers [0,1,0,2,3,0,0] = [1,3].
 (* FILL IN HERE *)
Proof. reflexivity. Qed.

Fixpoint countoddmembers (l:natlist) : nat :=
  (* FILL IN HERE *)
  match l with
    | nil => O
    | h :: t => match oddb h with
                  | true => S (countoddmembers t)
                  | false => countoddmembers t
                end
  end.

Example test_countoddmembers1:    countoddmembers [1,0,3,1,4,5] = 4.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.
Example test_countoddmembers2:    countoddmembers [0,2,4] = 0.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.
Example test_countoddmembers3:    countoddmembers nil = 0.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.
(** [] *)

(** **** Exercise: 3 stars, recommended (alternate) *)
(** Complete the definition of [alternate], which "zips up" two lists
    into one, alternating between elements taken from the first list
    and elements from the second.  See the tests below for more
    specific examples.

    Note: one natural and elegant way of writing [alternate] will fail
    to satisfy Coq's requirement that all [Fixpoint] definitions be
    "obviously terminating."  If you find yourself in this rut, look
    for a slightly more verbose solution that considers elements of
    both lists at the same time.  (One possible solution requires
    defining a new kind of pairs, but this is not the only way.)  *)

Fixpoint alternate (l1 l2 : natlist) : natlist :=
  (* FILL IN HERE *)
  match l1 with
      | nil => l2
      | h1 :: t1 => match l2 with
                    |  nil => l1
                    | h2 :: t2 => [h1, h2] ++ (alternate t1 t2)
                    end
  end.
Example test_alternate1:        alternate [1,2,3] [4,5,6] = [1,4,2,5,3,6].
 (* FILL IN HERE *)
Proof. reflexivity. Qed.
Example test_alternate2:        alternate [1] [4,5,6] = [1,4,5,6].
 (* FILL IN HERE *)
Proof. reflexivity. Qed.
Example test_alternate3:        alternate [1,2,3] [4] = [1,4,2,3].
 (* FILL IN HERE *)
Proof. reflexivity. Qed.
Example test_alternate4:        alternate [] [20,30] = [20,30].
 (* FILL IN HERE *)
Proof. reflexivity. Qed.
(** [] *)

(* ###################################################### *)
(** ** Bags via Lists *)

(** A [bag] (or [multiset]) is like a set, but each element can appear
    multiple times instead of just once.  One reasonable
    implementation of bags is to represent a bag of numbers as a
    list. *)

Definition bag := natlist.

(** **** Exercise: 3 stars, recommended (bag_functions) *)
(** Complete the following definitions for the functions
    [count], [sum], [add], and [member] for bags. *)

Fixpoint count (v:nat) (s:bag) : nat :=
  (* FILL IN HERE *)
  match s with
    | nil => O
    | h :: t => match beq_nat h v with
                  | false => count v t
                  | true => S (count v t)
                end
  end.
(* Why I cant replace *)

(** All these proofs can be done just by [reflexivity]. *)

Example test_count1:              count 1 [1,2,3,1,4,1] = 3.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.

Example test_count2:              count 6 [1,2,3,1,4,1] = 0.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.

(** Multiset [sum] is similar to set [union]: [sum a b] contains
    all the elements of [a] and of [b].  (Mathematicians usually
    define [union] on multisets a little bit differently, which
    is why we don't use that name for this operation.)
    For [sum] we're giving you a header that does not give explicit
    names to the arguments.  Moreover, it uses the keyword
    [Definition] instead of [Fixpoint], so even if you had names for
    the arguments, you wouldn't be able to process them recursively.
    The point of stating the question this way is to encourage you to
    think about whether [sum] can be implemented in another way --
    perhaps by using functions that have already been defined.  *)

Definition sum : bag -> bag -> bag :=
  (* FILL IN HERE *)
  app.

Example test_sum1:              count 1 (sum [1,2,3] [1,4,1]) = 3.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.

Definition add (v:nat) (s:bag) : bag :=
  (* FILL IN HERE *)
  v :: s.

Example test_add1:                count 1 (add 1 [1,4,1]) = 3.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.

Example test_add2:                count 5 (add 1 [1,4,1]) = 0.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.

Definition member (v:nat) (s:bag) : bool :=
  (* FILL IN HERE *)
  blt_nat O (count v s).

Example test_member1:             member 1 [1,4,1] = true.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.

Example test_member2:             member 2 [1,4,1] = false.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.
(** [] *)

(** **** Exercise: 3 stars, optional (bag_more_functions) *)
(** Here are some more bag functions for you to practice with. *)

Fixpoint remove_one (v:nat) (s:bag) : bag :=
  (* When remove_one is applied to a bag without the number to remove,
     it should return the same bag unchanged. *)
  (* FILL IN HERE *)
  match s with
    | nil => nil
    | h :: t => match beq_nat v h with
                  | true => t
                  | false => h :: remove_one v t
                end
  end.

Example test_remove_one1:         count 5 (remove_one 5 [2,1,5,4,1]) = 0.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.
Example test_remove_one2:         count 5 (remove_one 5 [2,1,4,1]) = 0.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.
Example test_remove_one3:         count 4 (remove_one 5 [2,1,4,5,1,4]) = 2.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.
Example test_remove_one4:
  count 5 (remove_one 5 [2,1,5,4,5,1,4]) = 1.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.
Fixpoint remove_all (v:nat) (s:bag) : bag :=
  match s with
    | nil => nil
    | h :: t => match beq_nat v h with
                  | true => remove_all v t
                  | false => h :: remove_all v t
                end
  end.

  (* FILL IN HERE *)

Example test_remove_all1:          count 5 (remove_all 5 [2,1,5,4,1]) = 0.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.
Example test_remove_all2:          count 5 (remove_all 5 [2,1,4,1]) = 0.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.
Example test_remove_all3:          count 4 (remove_all 5 [2,1,4,5,1,4]) = 2.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.

Example test_remove_all4:          count 5 (remove_all 5 [2,1,5,4,5,1,4,5,1,4]) = 0.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.

Fixpoint subset (s1:bag) (s2:bag) : bool :=
  (* FILL IN HERE *)
  match s1 with
    | [] => true
    | h :: t => match member h s2 with
                  | true => subset t (remove_one h s2)
                  | false => false
                end
  end.

Example test_subset1:              subset [1,2] [2,1,4,1] = true.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.
Example test_subset2:              subset [1,2,2] [2,1,4,1] = false.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.
(** [] *)

(** **** Exercise: 3 stars, recommended (bag_theorem) *)
(** Write down an interesting theorem about bags involving the
    functions [count] and [add], and prove it.  Note that, since this
    problem is somewhat open-ended, it's possible that you may come up
    with a theorem which is true, but whose proof requires techniques
    you haven't learned yet.  Feel free to ask for help if you get
    stuck! *)

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

(* ###################################################### *)
(** * Reasoning About Lists *)

(** Just as with numbers, simple facts about list-processing
    functions can sometimes be proved entirely by simplification. For
    example, the simplification performed by [reflexivity] is enough
    for this theorem... *)

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

(** ... because the [[]] is substituted into the match position
    in the definition of [app], allowing the match itself to be
    simplified. *)

(** Also, as with numbers, it is sometimes helpful to perform case
    analysis on the possible shapes (empty or non-empty) of an unknown
    list. *)

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

(** Here, the [nil] case works because we've chosen to define
    [tail nil = nil]. Notice that the [as] annotation on the [destruct]
    tactic here introduces two names, [n] and [l'], corresponding to
    the fact that the [cons] constructor for lists takes two
    arguments (the head and tail of the list it is constructing). *)

(** Usually, though, interesting theorems about lists require
    induction for their proofs. *)

(* ###################################################### *)
(** ** Micro-Sermon *)

(** Simply reading example proofs will not get you very far!  It is
    very important to work through the details of each one, using Coq
    and thinking about what each step of the proof achieves.
    Otherwise it is more or less guaranteed that the exercises will
    make no sense. *)

(* ###################################################### *)
(** ** Induction on Lists *)

(** Proofs by induction over datatypes like [natlist] are
    perhaps a little less familiar than standard natural number
    induction, but the basic idea is equally simple.  Each [Inductive]
    declaration defines a set of data values that can be built up from
    the declared constructors: a boolean can be either [true] or
    [false]; a number can be either [O] or [S] applied to a number; a
    list can be either [nil] or [cons] applied to a number and a list.

    Moreover, applications of the declared constructors to one another
    are the _only_ possible shapes that elements of an inductively
    defined set can have, and this fact directly gives rise to a way
    of reasoning about inductively defined sets: a number is either
    [O] or else it is [S] applied to some _smaller_ number; a list is
    either [nil] or else it is [cons] applied to some number and some
    _smaller_ list; etc. So, if we have in mind some proposition [P]
    that mentions a list [l] and we want to argue that [P] holds for
    _all_ lists, we can reason as follows:

      - First, show that [P] is true of [l] when [l] is [nil].

      - Then show that [P] is true of [l] when [l] is [cons n l'] for
        some number [n] and some smaller list [l'], assuming that [P]
        is true for [l'].

    Since larger lists can only be built up from smaller ones,
    eventually reaching [nil], these two things together establish the
    truth of [P] for all lists [l].  Here's a concrete example: *)

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

(** Again, this Coq proof is not especially illuminating as a
    static written document -- it is easy to see what's going on if
    you are reading the proof in an interactive Coq session and you
    can see the current goal and context at each point, but this state
    is not visible in the written-down parts of the Coq proof.  So a
    natural-language proof -- one written for human readers -- will
    need to include more explicit signposts; in particular, it will
    help the reader stay oriented if we remind them exactly what the
    induction hypothesis is in the second case.  *)

(** _Theorem_: For all lists [l1], [l2], and [l3],
   [(l1 ++ l2) ++ l3 = l1 ++ (l2 ++ l3)].

   _Proof_: By induction on [l1].

   - First, suppose [l1 = []].  We must show
       ([] ++ l2) ++ l3 = [] ++ (l2 ++ l3),
     which follows directly from the definition of [++].

   - Next, suppose [l1 = n::l1'], with
       (l1' ++ l2) ++ l3 = l1' ++ (l2 ++ l3)
     (the induction hypothesis). We must show
       ((n :: l1') ++ l2) ++ l3 = (n :: l1') ++ (l2 ++ l3).
]]
     By the definition of [++], this follows from
       n :: ((l1' ++ l2) ++ l3) = n :: (l1' ++ (l2 ++ l3)),
     which is immediate from the induction hypothesis.  []

  Here is an exercise to be worked together in class: *)

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'].
  Case "l1 = nil".
    reflexivity.
  Case "l1 = cons".
    simpl. rewrite -> IHl1'. reflexivity.  Qed.

(** For a slightly more involved example of an inductive proof
    over lists, suppose we define a "cons on the right" function
    [snoc] like this... *)

Fixpoint snoc (l:natlist) (v:nat) : natlist :=
  match l with
  | nil    => [v]
  | h :: t => h :: (snoc t v)
  end.

(** ... and use it to define a list-reversing function [rev]
    like this: *)

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

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

(** Now let's prove some more list theorems using our newly
    defined [snoc] and [rev].  For something a little more challenging
    than the inductive proofs we've seen so far, let's prove that
    reversing a list does not change its length.  Our first attempt at
    this proof gets stuck in the successor case... *)

Theorem rev_length_firsttry : forall l : natlist,
  length (rev l) = length l.
Proof.
  intros l. induction l as [| n l'].
  Case "l = []".
    reflexivity.
  Case "l = n :: l'".
    (* This is the tricky case.  Let's begin as usual by simplifying. *)
    simpl.
    (* Now we seem to be stuck: the goal is an equality involving
       [snoc], but we don't have any equations in either the
       immediate context or the global environment that have
       anything to do with [snoc]!

       We can make a little progress by using the IH to rewrite the
       goal... *)
    rewrite <- IHl'.
    (* ... but now we can't go any further. *)
Admitted.

(** So let's take the equation about [snoc] that would have
    enabled us to make progress and prove it as a separate lemma. *)

Theorem length_snoc : forall n : nat, forall l : natlist,
  length (snoc l n) = S (length l).
Proof.
  intros n l. induction l as [| n' l'].
  Case "l = nil".
    reflexivity.
  Case "l = cons n' l'".
    simpl. rewrite -> IHl'. reflexivity.  Qed.

(** Now we can complete the original proof. *)

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

(** For comparison, here are informal proofs of these two theorems:

    _Theorem_: For all numbers [n] and lists [l],
       [length (snoc l n) = S (length l)].

    _Proof_: By induction on [l].

    - First, suppose [l = []].  We must show
        length (snoc [] n) = S (length []),
      which follows directly from the definitions of
      [length] and [snoc].

    - Next, suppose [l = n'::l'], with
        length (snoc l' n) = S (length l').
      We must show
        length (snoc (n' :: l') n) = S (length (n' :: l')).
      By the definitions of [length] and [snoc], this
      follows from
        S (length (snoc l' n)) = S (S (length l')),
]]
      which is immediate from the induction hypothesis. [] *)

(** _Theorem_: For all lists [l], [length (rev l) = length l].

    _Proof_: By induction on [l].

      - First, suppose [l = []].  We must show
          length (rev []) = length [],
        which follows directly from the definitions of [length]
        and [rev].

      - Next, suppose [l = n::l'], with
          length (rev l') = length l'.
        We must show
          length (rev (n :: l')) = length (n :: l').
        By the definition of [rev], this follows from
          length (snoc (rev l') n) = S (length l')
        which, by the previous lemma, is the same as
          S (length (rev l')) = S (length l').
        This is immediate from the induction hypothesis. [] *)

(** Obviously, the style of these proofs is rather longwinded
    and pedantic.  After the first few, we might find it easier to
    follow proofs that give a little less detail overall (since we can
    easily work them out in our own minds or on scratch paper if
    necessary) and just highlight the non-obvious steps.  In this more
    compressed style, the above proof might look more like this: *)

(** _Theorem_:
     For all lists [l], [length (rev l) = length l].

    _Proof_: First, observe that
       length (snoc l n) = S (length l)
     for any [l].  This follows by a straightforward induction on [l].
     The main property now follows by another straightforward
     induction on [l], using the observation together with the
     induction hypothesis in the case where [l = n'::l']. [] *)

(** Which style is preferable in a given situation depends on
    the sophistication of the expected audience and on how similar the
    proof at hand is to ones that the audience will already be
    familiar with.  The more pedantic style is a good default for
    present purposes. *)

(* ###################################################### *)
(** ** [SearchAbout] *)

(** We've seen that proofs can make use of other theorems we've
    already proved, using [rewrite], and later we will see other ways
    of reusing previous theorems.  But in order to refer to a theorem,
    we need to know its name, and remembering the names of all the
    theorems we might ever want to use can become quite difficult!  It
    is often hard even to remember what theorems have been proven,
    much less what they are named.

    Coq's [SearchAbout] command is quite helpful with this.  Typing
    [SearchAbout foo] will cause Coq to display a list of all theorems
    involving [foo].  For example, try uncommenting the following to
    see a list of theorems that we have proved about [rev]: *)

SearchAbout rev.

(** Keep [SearchAbout] in mind as you do the following exercises and
    throughout the rest of the course; it can save you a lot of time! *)

(** Also, if you are using ProofGeneral, you can run [SearchAbout]
    with [C-c C-a C-a]. Pasting its response into your buffer can be
    accomplished with [C-c C-;]. *)

(* ###################################################### *)
(** ** List Exercises, Part 1 *)

(** **** Exercise: 3 stars, recommended (list_exercises) *)
(** More practice with lists. *)

Theorem app_nil_end : forall l : natlist,
  l ++ [] = l.
Proof.
  (* FILL IN HERE *)
  intro l. induction l as [|n l'].
  Case "l is [].".
  reflexivity.
  Case "l is cons n l.".
  simpl. rewrite -> IHl'. reflexivity.
Qed.

Theorem rev_snoc : forall l : natlist, forall v : nat,
  rev (snoc l v) = v :: (rev l).
Proof.
  intros l v. induction l as [| n l'].
  Case "l is [].".
  simpl. reflexivity.
  Case "l is n :: l'.".
  simpl. rewrite -> IHl'. simpl.  reflexivity.
Qed.

Theorem rev_involutive : forall l : natlist,
  rev (rev l) = l.
Proof.
  (* FILL IN HERE *)
  intro l. induction l as [| n l'].
  Case "l is [].".
     simpl. reflexivity.
  Case "l is cons n l'.".
  simpl. rewrite -> rev_snoc.
  rewrite -> IHl'. reflexivity.
Qed.

(** There is a short solution to the next exercise.  If you find
    yourself getting tangled up, step back and try to look for a
    simpler way. *)

Theorem app_ass4 : forall l1 l2 l3 l4 : natlist,
  l1 ++ (l2 ++ (l3 ++ l4)) = ((l1 ++ l2) ++ l3) ++ l4.
Proof.
  (* FILL IN HERE *)
  intros l1 l2 l3 l4. rewrite -> app_ass.
  rewrite -> app_ass. reflexivity.
Qed.

Theorem snoc_append : forall (l:natlist) (n:nat),
  snoc l n = l ++ [n].
Proof.
  (* FILL IN HERE *)
  intros l n. induction l as [| m l'].
  Case "l is [].".
  simpl. reflexivity.
  Case "l is l'++ [n].".
  simpl. rewrite -> IHl'. reflexivity.
Qed.

Theorem distr_rev : forall l1 l2 : natlist,
  rev (l1 ++ l2) = (rev l2) ++ (rev l1).
Proof.
  (* FILL IN HERE *)
  intros l1 l2. induction l1 as [| n l1'].
  Case "l1 is [].".
  simpl. rewrite -> app_nil_end. reflexivity.
  Case "l1 is n :: l1'.".
  simpl. rewrite -> snoc_append.
  rewrite -> snoc_append.
  rewrite -> IHl1'.
  rewrite -> app_ass.
  reflexivity.
Qed.
  (** An exercise about your implementation of [nonzeros]: *)

Lemma nonzeros_length : forall l1 l2 : natlist,
  nonzeros (l1 ++ l2) = (nonzeros l1) ++ (nonzeros l2).
Proof.
  (* FILL IN HERE *)
  intros l1 l2. induction l1 as [| n l1'].
  Case "l1 is [].".
  simpl. reflexivity.
  Case "l1 is n l1'.".
  simpl. destruct n as [| n'].
    SCase "n is 0.".
    rewrite -> IHl1'. reflexivity.
    SCase "n is S n'.".
    simpl. rewrite <- IHl1'. reflexivity.
Qed.
(** [] *)

(* ###################################################### *)
(** ** List Exercises, Part 2 *)

(** **** Exercise: 2 stars, recommended (list_design) *)
(** Design exercise:
     - Write down a non-trivial theorem involving [cons]
       ([::]), [snoc], and [append] ([++]).
     - Prove it. *)

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

(** **** Exercise: 2 stars, optional (bag_proofs) *)
(** If you did the optional exercise about bags above, here are a
    couple of little theorems to prove about your definitions. *)

Theorem count_member_nonzero : forall (s : bag),
  ble_nat 1 (count 1 (1 :: s)) = true.
Proof.
  (* FILL IN HERE *)
  intro s. simpl. reflexivity.
Qed.
(** The following lemma about [ble_nat] might help you in the next proof. *)

Theorem ble_n_Sn : forall n,
  ble_nat n (S n) = true.
Proof.
  intros n. induction n as [| n'].
  Case "0".
    simpl.  reflexivity.
  Case "S n'".
    simpl.  rewrite IHn'.  reflexivity.  Qed.

Theorem remove_decreases_count: forall (s : bag),
  ble_nat (count 0 (remove_one 0 s)) (count 0 s) = true.
Proof.
  (* FILL IN HERE *)
  admit.
(** [] *)

(** **** Exercise: 3 stars, optional (bag_count_sum) *)
(** Write down an interesting theorem about bags involving the
    functions [count] and [sum], and prove it.*)

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

(** **** Exercise: 4 stars, optional (rev_injective) *)
(** Prove that the [rev] function is injective, that is, *)

(* There is a hard way and an easy way to solve this exercise.*)
Theorem equal_after_rev : forall (l1 l2 : natlist), rev l1 = rev l2 -> l1 = l2.
(* FILL IN HERE *)
Proof. intros l1 l2 H1.
       assert (H2: rev l1 = rev l2 -> rev (rev l1) = rev (rev l2) ).
       intro H'. Admitted.

(** [] *)

(* ###################################################### *)
(** * Options *)

(** Here is another type definition that is often useful in
    day-to-day programming: *)

Inductive natoption : Type :=
  | Some : nat -> natoption
  | None : natoption.

(** One use of [natoption] is as a way of returning "error
    codes" from functions.  For example, suppose we want to write a
    function that returns the [n]th element of some list.  If we give
    it type [nat -> natlist -> nat], then we'll have to return some
    number when the list is too short! *)

Fixpoint index_bad (n:nat) (l:natlist) : nat :=
  match l with
  | nil => 42  (* arbitrary! *)
  | a :: l' => match beq_nat n O with
               | true => a
               | false => index_bad (pred n) l'
               end
  end.

(** On the other hand, if we give it type [nat -> natlist ->
    natoption], then we can return [None] when the list is too short
    and [Some a] when the list has enough members and [a] appears at
    position [n]. *)

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

Example test_index1 :    index 0 [4,5,6,7]  = Some 4.
Proof. reflexivity.  Qed.
Example test_index2 :    index 3 [4,5,6,7]  = Some 7.
Proof. reflexivity.  Qed.
Example test_index3 :    index 10 [4,5,6,7] = None.
Proof. reflexivity.  Qed.

(** This example is also an opportunity to introduce one more
    small feature of Coq's programming language: conditional
    expressions... *)

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

(** Coq's conditionals are exactly like those found in any other
    language, with one small generalization.  Since the boolean type
    is not built in, Coq actually allows conditional expressions over
    _any_ inductively defined type with exactly two constructors.  The
    guard is considered true if it evaluates to the first constructor
    in the [Inductive] definition and false if it evaluates to the
    second. *)

(** The function below pulls the [nat] out of a [natoption], returning
    a supplied default in the [None] case. *)

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

(** **** Exercise: 2 stars (hd_opt) *)
(** Using the same idea, fix the [hd] function from earlier so we don't
   have to pass a default element for the [nil] case.  *)

Definition hd_opt (l : natlist) : natoption :=
  (* FILL IN HERE *)
  match l with
    | nil => None
    | h :: t => Some h
  end.

Example test_hd_opt1 : hd_opt [] = None.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.

Example test_hd_opt2 : hd_opt [1] = Some 1.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.

Example test_hd_opt3 : hd_opt [5,6] = Some 5.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.
(** [] *)

(** **** Exercise: 1 star, optional (option_elim_hd) *)
(** This exercise relates your new [hd_opt] to the old [hd]. *)

Theorem option_elim_hd : forall (l:natlist) (default:nat),
  hd default l = option_elim default (hd_opt l).
Proof.
  (* FILL IN HERE *)
  intros l default. induction l as [| n l'].
  Case "l is [].". reflexivity.
  Case "l is cons.". simpl. reflexivity.
Qed.
  (** [] *)

(** **** Exercise: 2 stars, recommended (beq_natlist) *)
(** Fill in the definition of [beq_natlist], which compares
    lists of numbers for equality.  Prove that [beq_natlist l l]
    yields [true] for every list [l]. *)
Fixpoint beq_natlist (l1 l2 : natlist) : bool :=
  (* FILL IN HERE *)
  match l1, l2 with
    | [], [] => true
    | h1::t1, h2::t2 => if beq_nat h1 h2 then beq_natlist t1 t2 else false
    | _, _ => false
  end.
Example test_beq_natlist1 :   (beq_natlist nil nil = true).
 (* FILL IN HERE *)
Proof. reflexivity. Qed.

 (* FILL IN HERE *) Admitted.
Example test_beq_natlist3 :   beq_natlist [1,2,3] [1,2,4] = false.
 (* FILL IN HERE *)
Proof. reflexivity. Qed.

Theorem beq_natlist_refl : forall l:natlist,
  true = beq_natlist l l.
Proof.
  (* FILL IN HERE *)
  intro l. induction l as [| n l'].
  Case "l is [].". reflexivity.
  Case "l is cons.". simpl. rewrite <- beq_nat_refl. apply IHl'.
Qed.
(** [] *)

(* ###################################################### *)
(** * Extended Exercise: Dictionaries *)

(** As a final illustration of how fundamental data structures
    can be defined in Coq, here is the declaration of a simple
    [dictionary] data type, using numbers for both the keys and the
    values stored under these keys.  (That is, a dictionary represents
    a finite map from numbers to numbers.) *)

Module Dictionary.

Inductive dictionary : Type :=
  | empty  : dictionary
  | record : nat -> nat -> dictionary -> dictionary.

(** This declaration can be read: "There are two ways to construct a
    [dictionary]: either using the constructor [empty] to represent an
    empty dictionary, or by applying the constructor [record] to
    a key, a value, and an existing [dictionary] to construct a
    [dictionary] with an additional key to value mapping." *)

Definition insert (key value : nat) (d : dictionary) : dictionary :=
  (record key value d).

(** Here is a function [find] that searches a [dictionary] for a
    given key.  It evaluates evaluates to [None] if the key was not
    found and [Some val] if the key was mapped to [val] in the
    dictionary. If the same key is mapped to multiple values, [find]
    will return the first one it finds. *)

Fixpoint find (key : nat) (d : dictionary) : natoption :=
  match d with
  | empty         => None
  | record k v d' => if (beq_nat key k) then (Some v) else (find key d')
  end.

(** **** Exercise: 1 star (dictionary_invariant1) *)
(** Complete the following proof. *)

Theorem dictionary_invariant1 : forall (d : dictionary) (k v: nat),
  (find k (insert k v d)) = Some v.
Proof.
 (* FILL IN HERE *)
  intros d k v. simpl. rewrite <- beq_nat_refl. reflexivity.
Qed.
(** [] *)

(** **** Exercise: 1 star (dictionary_invariant2) *)
(** Complete the following proof. *)

Theorem dictionary_invariant2 : forall (d : dictionary) (m n o: nat),
  (beq_nat m n) = false -> (find m d) = (find m (insert n o d)).
Proof.
 (* FILL IN HERE *)
  intros d m n o H1.
  simpl. rewrite -> H1. reflexivity.
Qed.
(** [] *)

End Dictionary.

End NatList.


Require Export Arith.EqNat.

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

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

Definition new_bob (a:bool)(b:bool):bool := if a then b else false.

Fixpoint beq_natlist (l : natlist) (m : natlist) : bool :=
match l,m with
|[] , [] => true
| _ , [] => false
|[] , _ => false
|h :: t , h'::t' =>  new_bob (beq_nat h h') (beq_natlist t t')
end.

Check new.

Eval compute in (beq_natlist [1;2;3] [4;5;6]).
Eval compute in (beq_natlist [1;1;1] [1;1;1]).

Example test_beq_natlist1 : (beq_natlist [] [] = true).
Proof.
simpl. reflexivity.
Qed.

Example test_beq_natlist2 : beq_natlist [1;2;3] [1;2;3] = true.
Proof.
simpl. reflexivity.
Qed.

Example test_beq_natlist3 : beq_natlist [1;2;3] [1;2;4] = false.
Proof.
simpl. reflexivity.
Qed.


Require Import MeetSemiLattice.
Require Import MyNotations.
Require Import PreorderEquiv.
Require Import Coq.Lists.List.
Require Import Coq.Lists.SetoidList.
Require Import EquivlistMap.

(** * Definition of distributive lattices
    They are meet semilattices
    with joins. As our meet semilattices have smallest elements,
    we don't need to reintroduce them here. *)

Section DistrLattice_Def.

  Class DistrLattice `{T:Type} (Tle:Le T) :=
    MkDistrLattice
      {
        (* meet semilattice *)
        dl_msl :> MeetSemiLattice Tle;
        (* join *)
        dl_join :> Join T;
        join_l : forall x y, x ≤ x ⊔ y;
        join_r : forall x y, y ≤ x ⊔ y;
        join_univ : forall x y z, x ≤ z -> y ≤ z -> x ⊔ y ≤ z;
        (* distributivity *)
        bdistr_le : forall x y z, x ⊓ (y ⊔ z) ≤ (x ⊓ y) ⊔ (x ⊓ z);
      }.

  Context {T : Type}.
  Context {Tle : Le T}.
  Context {DL : DistrLattice Tle}.

  Existing Instance DL.
  Existing Instance Feq_equiv.

  (** ** Properties of the join *)

  Lemma join_le_l : forall x y z, x ≤ y -> x ⊔ z ≤ y ⊔ z.
  Proof.
    intros.
    apply join_univ.
    apply (le_trans _ y _ H).
    apply join_l.
    apply join_r.
  Qed.

  Lemma join_le_r : forall x y z, x ≤ y -> z ⊔ x ≤ z ⊔ y.
  Proof.
    intros.
    apply join_univ.
    apply join_l.
    apply (le_trans _ y _ H).
    apply join_r.
  Qed.

  Lemma join_le : forall x y z w, x ≤ y -> z ≤ w -> x ⊔ z ≤ y ⊔ w.
  Proof.
    intros.
    apply (le_trans _ (x ⊔ w) _).
    apply (join_le_r _ _ _ H0).
    apply (join_le_l _ _ _ H).
  Qed.

  Add Morphism join with signature (Feq ==> Feq ==> Feq) as join_morphism.
  Proof.
    firstorder.
    apply (join_le _ _ _ _ H H0).
    apply (join_le _ _ _ _ H2 H1).
  Qed.

  Lemma join_comm : forall x y, x ⊔ y = y ⊔ x.
  Proof.
    unfold Feq.
    intros. split.
    apply join_univ. apply join_r. apply join_l.
    apply join_univ. apply join_r. apply join_l.
  Qed.

  Lemma join_assoc : forall x y z, x ⊔ (y ⊔ z) = (x ⊔ y) ⊔ z.
  Proof.
    intros.
    unfold Feq. split.

    apply join_univ.
    apply (le_trans _ (x ⊔ y) _).
    apply join_l.
    apply join_l.
    apply join_le_l.
    apply join_r.

    apply join_univ.
    apply join_le_r.
    apply join_l.
    apply (le_trans _ (y ⊔ z) _).
    apply join_r.
    apply join_r.
  Qed.

  Lemma join_idem : forall x, x ⊔ x = x.
  Proof.
    intros.
    unfold Feq. split.
    apply (join_univ x x x (le_refl x) (le_refl x)).
    apply join_l.
  Qed.

  Lemma join_bot_l : forall x, ⊥ ⊔ x = x.
  Proof.
    intros. split.
    apply join_univ. apply bot_le.
    apply le_refl.
    apply join_r.
  Qed.

  Lemma join_bot_r : forall x, x ⊔ ⊥ = x.
  Proof.
    intro. setoid_rewrite join_comm.
    apply join_bot_l.
  Qed.

  Lemma join_top_l : forall x, ⊤ ⊔ x = ⊤.
  Proof.
    intro. split.
    apply join_univ. apply le_refl.
    apply top_le.
    apply join_l.
  Qed.

  Lemma join_top_r : forall x, x ⊔ ⊤ = ⊤.
  Proof.
    intro. setoid_rewrite join_comm.
    apply join_top_l.
  Qed.

  (** ** Equivalent definitions of the order *)
  Lemma order_join : forall x y, x ≤ y <-> x ⊔ y = y.
  Proof.
    intros.
    unfold iff. split.

    intros. split.
    apply (le_trans _ (y ⊔ y) _).
    apply (join_le_l _ _ _ H).
    setoid_rewrite (join_idem y).
    apply le_refl.
    apply join_r.

    intros. setoid_rewrite <- H.
    apply join_l.
  Qed.

  (** ** Distributivity *)
  Lemma bdistr_eq : forall x y z, x ⊓ (y ⊔ z) = (x ⊓ y) ⊔ (x ⊓ z).
  Proof.
    intros.
    split.
    - apply bdistr_le.
    - apply join_univ ; apply meet_le_r.
      apply join_l.
      apply join_r.
  Qed.

  (** ** Finite joins *)

  Definition Vf l :=
    fold_left (fun accu x => accu ⊔ x) l ⊥.

  Lemma Vf_nil : Vf [] = ⊥.
  Proof.
    reflexivity.
  Qed.

  Lemma Vf_singleton : forall a, Vf [a] = a.
  Proof.
    intros. unfold Vf. simpl. rewrite join_bot_l.
    reflexivity.
  Qed.

  Lemma cons_app : forall (a : T) (b : list T), a :: b ≡ [a] ++ b.
  Proof.
    intros. reflexivity.
  Qed.

  Lemma Vf_cons : forall a b, Vf (a :: b) = a ⊔ Vf b.
  Proof.
    intros.
    unfold Vf. simpl.
    set (F := fold_left (fun accu x => accu ⊔ x)).
    assert (forall u v, F u v = v ⊔ F u ⊥).
    induction u ; intros.
    - simpl. rewrite join_bot_r. reflexivity.
    - simpl. rewrite IHu.
      assert (F u (⊥ ⊔ a0) = (⊥ ⊔ a0) ⊔ F u ⊥).
      apply IHu.
      rewrite H.
      rewrite join_bot_l.
      rewrite join_assoc.
      reflexivity.
    - assert (a ⊔ F b ⊥ = (⊥ ⊔ a) ⊔ F b ⊥).
      rewrite join_bot_l. reflexivity.
      rewrite H0.
      apply H.
  Qed.

  Lemma Vf_meet : forall a b, a ⊓ Vf b = Vf (map (a ⊓) b).
  Proof.
    intro.
    induction b ; simpl.
    - rewrite Vf_nil.
      meetsemilattice.
    - rewrite Vf_cons.
      rewrite bdistr_eq.
      rewrite Vf_cons.
      rewrite IHb.
      reflexivity.
   Qed.

  Lemma Vf_app : forall a b, Vf (a ++ b) = Vf a ⊔ Vf b.
  Proof.
    induction a ; intros.
    - unfold Vf. simpl.
      rewrite join_bot_l.
      reflexivity.
    - simpl.
      rewrite Vf_cons.
      rewrite Vf_cons.
      rewrite <- join_assoc.
      rewrite IHa.
      reflexivity.
  Qed.

  Instance in_contains : Contains T (list T) := (InA Feq).

  Lemma Vf_in_le : forall a U, a ∈ U -> a ≤ Vf U.
  Proof.
    intros.
    induction H ; rewrite Vf_cons.
    - rewrite H.
      apply join_l.
    - apply le_trans with (y0 := Vf l).
      assumption.
      apply join_r.
  Qed.

  Lemma Vf_univ : forall U y, (forall x, x ∈ U -> x ≤ y) -> Vf U ≤ y.
  Proof.
    intros.
    induction U.
    + rewrite Vf_nil.
      apply bot_le.
    + rewrite Vf_cons.
      apply join_univ.
      apply H.
      apply InA_cons_hd.
      reflexivity.
      apply IHU.
      intros.
      apply H.
      apply InA_cons_tl.
      apply H0.
  Qed.

  Lemma Vf_incl : forall U V, inclA Feq U V -> Vf U ≤ Vf V.
  Proof.
    intros.
    apply Vf_univ.
    intros.
    apply Vf_in_le.
    apply H.
    apply H0.
  Qed.

  Lemma Vf_proper : forall U V, equivlistA Feq U V -> Vf U = Vf V.
  Proof.
    intros.
    split ; (
      apply Vf_incl ;
      unfold inclA ; intros ;
      apply H ; assumption).
  Qed.

End DistrLattice_Def.

Add Parametric Morphism (T : Type) (Tle : Le T) (Tdl : DistrLattice Tle) : (@dl_join T Tle Tdl) with signature (Feq ==> Feq ==> Feq) as f_join_morphism.
Proof.
  apply join_morphism_Proper.
Qed.

Add Parametric Morphism (T : Type) (Tle : Le T) (Tdl : DistrLattice Tle) : (@Vf T Tle Tdl) with signature (equivlistA Feq ==> Feq) as Vf_morphism.
Proof.
  apply Vf_proper.
Qed.

Add Parametric Morphism (T : Type) (R : Type) (Req : relation R) (Requiv : Equivalence Req) : (@map T R) with signature (pointwise_relation T Req  ==> equivlistA (≡) ==> equivlistA Req) as map_morphism.
Proof.
  unfold equivlistA ; intros.
  set (L := @inA_map_iff T (≡) _ R Req Requiv).
  assert (forall f : T -> R, Proper ((≡) ==> Req) f).
  unfold Proper, respectful. intros. subst. reflexivity.
  unfold contains, in_containsR, in_containsQ in L.
  rewrite L.
  rewrite L.
  split.
  - intro.
    destruct H2.
    exists x2.
    destruct H2.
    split.
    + rewrite <- H0.
      apply H2.
    + rewrite H3.
      apply H.
  - intro.
    destruct H2.
    exists x2.
    destruct H2.
    split.
    + rewrite H0.
      apply H2.
    + rewrite H3.
      symmetry.
      apply H.
  - apply H1.
  - apply H1.
Qed.

(** * Distributive lattice morphisms *)

Section Frame_Morphism_Definition.
  Context {tA : Type}.
  Context {leA : Le tA}.
  Existing Instance Feq_equiv.

  Context {tB : Type}.
  Context {leB : Le tB}.

  Require Import Coq.Program.Basics.

  Variable (DLA : @DistrLattice tA leA).
  Variable (DLB : @DistrLattice tB leB).

  Definition mslA := @dl_msl tA leA DLA.
  Definition mslB := @dl_msl tB leB DLB.

  Variable (f : tA -> tB).
  Class DLMorphism :=
    MkDLMorphism
      {
        dlmorph_mslmorph :> MSLMorphism mslA mslB f;
        (* preserves countable joins *)
        morph_join: forall a b, f (a ⊔ b) = (f a) ⊔ (f b)
      }.

  Variable dlmorph : DLMorphism.
  Existing Instance dlmorph.

  Proposition morph_Vf : forall a, f (Vf a) = Vf (map f a).
  Proof.
    induction a.
    - simpl.
      rewrite Vf_nil.
      rewrite Vf_nil.
      apply mslmorph_bot.
      apply dlmorph_mslmorph.
    - simpl.
      rewrite Vf_cons.
      rewrite Vf_cons.
      rewrite morph_join.
      rewrite IHa.
      reflexivity.
  Qed.

End Frame_Morphism_Definition.


Require Import ssreflect ssrbool eqtype ssrnat seq.

Set Implicit Arguments.
Require Import bigop Omega fintype.

Definition f (n:nat) := (\sum_(i<n.+1) i).

Lemma S10 : f(10)=55.

Theorem sommation : forall (n : nat), 2 * sumn (iota 1 n) = n*(n.+1).
induction n; first trivial.
replace (n.+1) with (n+1) by ring.
rewrite (iota_add ).
rewrite sumn_cat.
simpl.
ring_simplify.
rewrite IHn.
ring.
Qed.

Theorem sommation_ssr n : 2 * sumn (iota 1 n) = n * (n + 1).
Proof.
  elim: n => [//= | n IHn].
  (* rewrite -{1 3}[n.+1]addn1. *)
  rewrite -(addn1 n) iota_add sumn_cat.
  ring_simplify.
  rewrite IHn.
  simpl.
  ring.
Qed.

Theorem sommation3 n : 2 * sumn (iota 1 n) = n * (n + 1).
Proof.
  elim: n => [//= | n IHn].
  (* rewrite -{1 3}[n.+1]addn1. *)
  rewrite -(addn1 n).
  rewrite
 iota_add /= sumn_cat !mulnDr IHn /= mulnC -!addnA.
  congr (_ + _).
  by rewrite muln0 !muln1 /= !add0n addn0 [RHS]addnA [RHS]addnC [n + 1]addnC.
Qed.

Theorem sommation4 n : 2 * (\sum_(i<n.+1) i) = n * (n + 1).
elim : n => [|n IHn].
rewrite big_ord_recr.
rewrite big_ord0.
reflexivity.
replace (\sum_(i < n.+2) i) with ((\sum_(i < n.+1) i) + n.+1).
rewrite mulnDr.
rewrite IHn.
ring.
symmetry.
apply big_ord_recr.
Qed.


Module Ex1.
Fixpoint factorial (n:nat) : nat :=
    match n with
    | 0 => 1
    | S n => (n+1) * factorial (n)
    end.

Example test_factorial1: (factorial 3) = 6.
Proof. simpl. reflexivity. Qed.

Example test_factorial2: (factorial 5) = (mult 10 12).
Proof. simpl. reflexivity. Qed.

End Ex1.


(*|
###################################
Every proof deserves its own "view"
###################################

It is obvious that the validity of statement strongly depends on the
number sets appearing in its formulation. That leads to an illusion
that the proof itself should rely on particular properties of these
numbers. For instance, the definition of natural numbers in Coq
follows `Peano's encoding
<https://en.wikipedia.org/wiki/Peano_axioms>`__:
|*)

Print nat. (* .unfold .messages *)

(*|
Here, a natural number is created either from the constant ``O`` or by
applying the function ``S`` to another natural number. ``S`` is the
successor function which represents adding 1 to a number. Thus, ``O``
is zero, ``S O`` is one, ``S (S O)`` is two, ``S (S (S O))`` is three,
and so on.

In turn, this encoding of natural numbers brings us the ``nat_ind``
induction principle playing a vital role in proving properties of
natural numbers:
|*)

Check nat_ind. (* .unfold .messages *)

(*|
The induction principle, usually called `mathematical induction
<https://en.wikipedia.org/wiki/Mathematical_induction>`__, reads the
following. Proposition :math:`P(n)` holds for every natural number
:math:`n = 0, 1, 2, \dots` if the following two statements are
satisfied:

1. The **initial** or **base state**: the proposition holds for
   :math:`n = 0`.
2. The **induction step**: if the proposition holds for :math:`n`,
   then it holds for :math:`n + 1`.

Below is our illustrating example the consideration of which we start
from applying the induction principle (tactic ``induction``):
|*)

Require Import PeanoNat.

Lemma triangle_num : forall n : nat, Nat.even (n * S n) = true.
Proof.
  intro n. rewrite Nat.even_mul, Bool.orb_true_iff.
  induction n; tauto.
Qed.

(*|
Here, despite the use of the induction principle, our major
observation relates to the fact that ``n`` or ``S n`` is even. The
role of the induction principle is to use this fact in order to
conclude the evenness of ``S n`` or ``S (S n)``.
|*)

Inductive parity n :=
| parity_even : Nat.even n = true -> parity n
| parity_even_S : Nat.even (S n) = true -> parity n.

Lemma parity_spec : forall n : nat, parity n.
Proof.
  intro n. induction n as [| ? [? | ?]]; now constructor.
Qed.

Lemma triangle_num' : forall n : nat, Nat.even (n * S n) = true.
Proof.
  intro n. rewrite Nat.even_mul, Bool.orb_true_iff.
  destruct (parity_spec n); tauto.
Qed.

(*| ---- |*)

Lemma mod_sym : forall a b : nat,
    a <> 0 -> b <> 0 -> a mod b = b mod a <-> a = b.
Abort. (* .none *)

(*|
After some failed tries, I recommend you to take a coffee break and,
then, make a try with pen and paper. It should stimulate you to turn
into a case analysis and find out three distinct cases: ``a < b``, ``a
= b``, and ``a > b``. However, in comparison with mathematical
induction, reasoning about cases in Coq seems not so convenient. The
point is that every case is a proposition (``Prop``), not inductive
type; hence, our case analysis is non-constructive.

The good news is that Coq provides an appropriate inductive type for
case analysis:
|*)

Print sumbool. (* .unfold .messages *)

(*|
In turn, our case analysis is expressed by decidable equality:
|*)

Require Import Compare_dec. (* .none *)
Check lt_eq_lt_dec. (* .unfold .messages *)

(*|
Returning to our example, one can now split the set of natural numbers
into the desired cases:
|*)

Require Import Compare_dec.

Lemma mod_sym : forall a b : nat,
    a <> 0 -> b <> 0 -> a mod b = b mod a <-> a = b.
Proof.
  intros a b Ha Hb. pose proof (lt_eq_lt_dec a b) as H.
  destruct H as [H | H]. 1: destruct H as [H | H].
  Show 1. (* .unfold .messages *)
  Show 2. (* .unfold .messages *)
  Show 3. (* .unfold .messages *)

(*|
The rest of proof is straightforward:
|*)

  all: split; auto.
  - apply Nat.mod_small in H. intro H0. rewrite H in H0.
    pose proof (Nat.mod_upper_bound b a Ha) as H1. rewrite <- H0 in H1.
    contradict H1. apply Nat.lt_irrefl.
  - apply Nat.mod_small in H. intro H0. rewrite H in H0.
    pose proof (Nat.mod_upper_bound a b Hb) as H1. rewrite H0 in H1.
    contradict H1. apply Nat.lt_irrefl.
Qed.

(*|
In conclusion, we have emphasized the importance of inductive types to
enumerate all elements of a set (for instance, natural numbers).
However, we are not restricted to the standard encoding of the set and
are able to introduce own principles for the enumeration. But we need
always keep in mind that such a procedure should be decidable. In
contrast, non-decidable procedures are propositions (``Prop``) and not
the subject for case analysis (due to the lack of `excluded-middle law
<https://en.wikipedia.org/wiki/Law_of_excluded_middle>`__ in
constructive logic).

----

Below are appropriate examples found on `Stack Overflow
<https://stackoverflow.com/>`__:

1. `<../examples/contradiction-on-natural-numbers-zero-test.html>`__
2. `<../examples/coq-how-to-prove-if-statements-involving-strings.html>`__
3. `<../examples/coq-how-to-prove-max-a-b-ab.html>`__
4. `<../examples/coq-leb-does-not-give-me-an-hypothesis-after-case-or-induction.html>`__
5. `<../examples/finding-a-well-founded-relation-to-prove-termination-of-a-function-that-stops-de.html>`__
6. `<../examples/how-does-decidable-equality-works-with-list-remove.html>`__
7. `<../examples/pattern-matching-with-even-and-odd-cases.html>`__
8. `<../examples/prove-that-the-only-zero-length-vector-is-nil.html>`__
|*)


(*
    Exercise 1.
*)
Inductive truth: Set :=
    | Yes
    | No
    | Maybe.

Definition and (a b: truth): truth :=
    match a, b with
        | _, No => No
        | No, _ => No
        | _, Maybe => Maybe
        | Maybe, _ => Maybe
        | Yes, Yes => Yes
    end.

Definition or (a b: truth): truth :=
    match a, b with
        | _, Yes => Yes
        | Yes, _ => Yes
        | Maybe, _ => Maybe
        | _, Maybe => Maybe
        | No, No => No
    end.

Definition not (a: truth): truth :=
    match a with
        | Yes => No
        | No => Yes
        | Maybe => Maybe
    end.

Theorem and_commutative: forall a b: truth, and a b = and b a.
    destruct a; destruct b; reflexivity.
Qed.

Theorem and_distribute: forall a b c: truth, and a (or b c) = or (and a b) (and a c).
    destruct a; destruct b; destruct c; reflexivity.
Qed.

(*
    Exercise 2.
*)
Require Import List.

Section slist.
    Variable T: Set.

    Inductive slist: Set :=
        | empty: slist
        | single: T -> slist
        | concat: slist -> slist -> slist.

    Fixpoint flatten (l: slist): list T :=
        match l with
            | empty => nil
            | single a => cons a nil
            | concat l1 l2 => flatten l1 ++ flatten l2
        end.

    Theorem flatten_distribute: forall l1 l2: slist,
        (flatten (concat l1 l2)) = (flatten l1) ++ (flatten l2).
        destruct l1; destruct l2; reflexivity.
    Qed.
End slist.
Implicit Arguments empty [T].

(*
    Exercise 3.
*)
Inductive binop: Set := Plus | Times.

Inductive exp: Set :=
    | Const: nat -> exp
    | Binop: binop -> exp -> exp -> exp.

Definition binopDenote (b: binop): nat -> nat -> nat :=
    match b with
        | Plus => plus
        | Times => mult
    end.

Fixpoint expDenote (e: exp): nat :=
    match e with
        | Const n => n
        | Binop b e1 e2 => (binopDenote b) (expDenote e1) (expDenote e2)
    end.

Inductive instr: Set :=
    | iConst: nat -> instr
    | iBinop: binop -> instr.
Definition prog := list instr.
Definition stack := list nat.

Definition instrDenote (i: instr) (s: stack): option stack :=
    match i with
        | iConst n => Some (n :: s)
        | iBinop b =>
            match s with
                | arg1 :: arg2 :: s' => Some ((binopDenote b) arg1 arg2 :: s')
                | _ => None
            end
    end.

Fixpoint progDenote (p: prog) (s: stack): option stack :=
    match p with
        | nil => Some s
        | i :: p' =>
            match instrDenote i s with
                | None => None
                | Some s' => progDenote p' s'
            end
    end.

Fixpoint compile (e: exp): prog :=
    match e with
        | Const n => iConst n :: nil
        | Binop b e1 e2 => compile e2 ++ compile e1 ++ iBinop b :: nil
    end.


(*
  10152160137 陈弈君 homeowork 4
*)

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

(* 1.Theorem app_nil_r : ∀ l : natlist,  l ++ [] = l. *)
Theorem app_nil_r : forall l : natlist,  l ++ [] = l.

Proof.
  intros l. induction l as[ |n l' IHl'].
  - simpl. reflexivity.
  - simpl. rewrite -> IHl'. reflexivity.
Qed.

(* 2.Theorem rev_app_distr: ∀ l1 l2 : natlist,  rev (l1 ++ l2) = rev l2 ++ rev l1. *)

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

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.

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

(* 3.Theorem rev_involutive : ∀ l : natlist,  rev (rev l) = l. *)
Theorem rev_involutive : forall l : natlist,  rev (rev l) = l.

Proof.
  intros l. induction l as [|n l' IHl'].
  - simpl. reflexivity.
  - simpl. rewrite rev_app_distr. simpl. rewrite IHl'. reflexivity.
Qed.


From elpi Require Import elpi.
From HB Require Import structures.
From mathcomp Require Import all_ssreflect.

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

(** # This is the doc of seq, use it! #*)

(**

----
Exercise 1:
    - look up the documentation of [take] and [drop]
    - prove this by induction (mind the recursive argument)
*)
Lemma cat_take_drop T n (s : seq T) : take n s ++ drop n s = s.
Proof.
(*D*)by elim: s n => [|x s IHs] [|n] //=; rewrite IHs.
(*A*)Qed.

(** Exercise 2:
   - look at the definition of [take] and [size] and prove the following lemma
   - the proof goes by cases (recall the spec lemma [leqP])
*)
Lemma size_take T n (s : seq T) :
  size (take n s) = if n < size s then n else size s.
Proof.
(*D*)have [le_sn | lt_ns] := leqP (size s) n; first by rewrite take_oversize.
(*D*)by rewrite size_takel // ltnW.
(*A*)Qed.

(** Exercise 3:
    - another proof by cases
    - remark that also [eqP] is a spec lemma
*)
Lemma takel_cat T n (s1 s2 : seq T) :
  n <= size s1 -> take n (s1 ++ s2) = take n s1.
Proof.
(*D*)move=> Hn; rewrite take_cat ltn_neqAle Hn andbT.
(*D*)by case: eqP => //= ->; rewrite subnn take0 cats0 take_size.
(*A*)Qed.

(** Exercise 4:
    - Look up the definition of [rot]
    - Look back in this file the lemma [cat_take_drop]
    - can you rewrite with it right-to-left in the right-hand-side of the goal?
*)
Lemma size_rot T n (s : seq T) : size (rot n s) = size s.
Proof.
(*D*)by rewrite -[s in RHS](cat_take_drop n) /rot !size_cat addnC.
(*A*)Qed.

(** Exercise 5:
    - which is the size of an empty sequence?
    - Use lemmas about [size] and [filter]
*)
Lemma has_filter (T : eqType) a (s : seq T)  : has a s = (filter a s != [::]).
Proof.
(*D*)by rewrite -size_eq0 size_filter has_count lt0n.
(*A*)Qed.

(** Exercise 6:
    - prove that by induction
*)
Lemma filter_all T a (s : seq T) : all a (filter a s).
Proof.
(*D*)by elim: s => //= x s IHs; case: ifP => //= ->.
(*A*)Qed.

(** Exercise 7:
  - prove that view (one branch is by induction)
*)
Lemma all_filterP T a (s : seq T) :
  reflect (filter a s = s) (all a s).
Proof.
(*D*)apply: (iffP idP) => [| <-]; last exact: filter_all.
(*D*)by elim: s => //= x s IHs /andP[-> Hs]; rewrite IHs.
(*A*)Qed.

(** Exercise 9:
    - prove this by induction on [s]
*)
Lemma allP (T : eqType) (a : pred T) (s : seq T) :
  reflect (forall x, x \in s -> a x) (all a s).
Proof.
(*D*)elim: s => [|x s IHs] /=; first by exact: ReflectT.
(*D*)rewrite andbC; case: IHs => IHs /=.
(*D*)  apply: (iffP idP) => [Hx y|].
(*D*)    by rewrite inE => /orP[ /eqP-> // | /IHs ].
(*D*)  by move=> /(_ x); apply; rewrite inE eqxx.
(*D*)by apply: ReflectF=> H; apply: IHs => y Hy; apply H; rewrite inE orbC Hy.
(*A*)Qed.

(** *** Exercise 10:
  - check out the definitions and theory of [leq] and [maxn]
  - use only [rewrite] and [apply]
  - proof sketch:
<<
   n <= m = n - m == 0
          = m + n - m == m + 0
          = maxn m n == m
>> *)
Lemma maxn_idPl m n : reflect (maxn m n = m) (m >= n).
(*D*)Proof. by rewrite -subn_eq0 -(eqn_add2l m) addn0 -maxnE; apply: eqP. Qed.