Require Export Induction.
Module NatList.

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

Check (pair 3 5).

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

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

Check (pair 3 5).
Example fst_eq_3: fst (pair 3 5) = 3.

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

Example snd_eq_5: fst (pair 3 5) = 5.

Compute (fst (pair 3 5)).

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

Example swap_pair_test: swap_pair (3, 2) = (2, 3).

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

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

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

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

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

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

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

Notation "[ ]" := nil.

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

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

Fixpoint length (l:natlist) : nat :=
  match l with
   | [] => 0
   | _ :: xs  => 1 + (length xs)
  end.

Example length_3: length [1; 2; 3] = 3.
Proof. reflexivity. Qed.

Fixpoint repeat (n count : nat) : natlist :=
  match count with
   | 0 => []
   | S count' => n :: (repeat n count')
  end.

Fixpoint repeat' (n count : nat) : natlist :=
  if beq_nat count 5 then []
  else repeat n count
  .

Example repeat_42_3: repeat 42 3 = [42; 42; 42].
  Proof. reflexivity. Qed.
Example repeat'_42_4: repeat' 42 3 = [42; 42; 42].
  Proof. reflexivity. Qed.
Example repeat'_42_5: repeat' 42 5 = [].
  Proof. reflexivity. Qed.

Theorem repeat_length : forall n : nat,
    length(repeat 0 n) = n.
Proof.
  intros n.
  simpl.
  induction n.
  simpl.
  reflexivity.
  simpl.
  rewrite -> IHn.
  reflexivity.
Qed.

Fixpoint one_exactly (el : nat) (l : natlist) (ok : bool) : bool :=
  match l with
  | [] => ok
  | n :: xs => if beq_nat n el
                 then (one_exactly el xs ok)
                 else (one_exactly el xs false)
  end.

Example one_exactly1 : one_exactly 10 [10;10;10] true = true.
Proof. reflexivity. Qed.

Example  one_exactly2 := one_exactly 11 [11; 10; 11] true = false.
Proof. reflexivity. Qed.

Fixpoint app (l1 l2 : natlist) : natlist :=
 match l1 with
  | [] => l2
  | h :: xs => h :: (app xs l2)
 end.

Example append_ex1: app [1; 2] [3; 4; 5] = [1; 2; 3; 4; 5].

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

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

Definition hd (default:nat) (l:natlist) : nat :=
  match l with
  | [] => default
  | h :: _ => h
  end.

Definition tl (l:natlist) : natlist :=
  match l with
  | [] => []
  | _ :: xs => xs
  end.

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

Fixpoint nonzeros (l:natlist) : natlist :=
  match l with
  | [] => []
  | 0 :: xs => nonzeros xs
  | h :: xs => h :: nonzeros xs
  end.

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

Inductive natlistprod : Type :=
  pairl : natlist -> natlist -> natlistprod.

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

Fixpoint alternate (l1 l2 : natlist) : natlist :=
  match (l1, l2) with
    | (nil, _) => l2
    | (_, nil) => l1
    | (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. reflexivity. Qed.

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

Example test_alternate3:
  Check e bool (b c 0).
alternate [1;2;3] [4] = [1;4;2;3].
  Proof. reflexivity. Qed.

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

Definition bag := natlist.

Fixpoint count (v:nat) (s:bag) : nat :=
  match s with
   | [] => 0
   | x :: xs => match beq_nat x v with
                | true =>  1 + (count v xs)
                | false => count v xs
                end
  end.

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

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

Definition sum : bag -> bag -> bag := app.

Example test_sum1: count 1 (sum [1;2;3] [1;4;1]) = 3.
  Proof. reflexivity. Qed.

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

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

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

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

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

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. *)
  match s with
    | nil => nil
    | h :: tl => match (beq_nat h v) with
                   | true => tl
                   | false => h :: remove_one v tl
                 end
  end.

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

Fixpoint remove_all (v:nat) (s:bag) : bag :=
  match s with
    | nil => nil
    | h :: t => match (beq_nat h v) with
                   | true => remove_all v t
                   | false => h :: remove_all v t
                 end
  end.

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

Fixpoint subset (s1:bag) (s2:bag) : bool :=
  match s1 with
   | [] => true
   | x :: xs => andb  (member x s2) (subset xs (remove_one x s2))
  end.

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

Theorem 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 [|n1' l1' IHl1'].
 simpl. reflexivity.
 simpl. rewrite -> IHl1'. reflexivity.
Qed.

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

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

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

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

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

Theorem rev_app_distr: forall l1 l2 : natlist,
  rev (l1 ++ l2) = rev l2 ++ rev l1.
Proof.
  intros l1 l2. induction l1.
  rewrite -> nil_app.
  assert (H1: rev [] = []). { reflexivity. }
  rewrite -> H1.
  rewrite -> app_nil_r.
  reflexivity.
  simpl.
  rewrite -> IHl1.
  rewrite -> app_assoc. reflexivity.
Qed.

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

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

Lemma nonzeros_app : forall l1 l2 : natlist,
nonzeros (l1 ++ l2) = (nonzeros l1) ++ (nonzeros l2).
Proof.
  intros l1 l2.
  induction l1.
  reflexivity.
  simpl.
  destruct n.
  rewrite -> IHl1. reflexivity.
  simpl. rewrite -> IHl1. reflexivity.
Qed.


Require Import Arith Lia.

Require Import ssreflect ssrbool ssrfun.

Set Default Goal Selector "!".

Definition nat_norm := (Nat.add_0_r, Nat.add_succ_r, Nat.sub_0_r, Nat.mul_1_r, Nat.div_1_r).

Lemma iter_plus {X: Type} {f: X -> X} {x: X} {n m: nat} :
  Nat.iter (n + m) f x = Nat.iter m f (Nat.iter n f x).
Proof. by rewrite Nat.add_comm /Nat.iter nat_rect_plus. Qed.

Lemma mod_frac_lt {n m: nat} : (S m) mod (n + 1) = 0 -> S m < (S m * (n + 2)) / (n + 1).
Proof.
    have ->: S m * (n + 2) = S m + S m * (n + 1) by lia.
    have := Nat.div_mod_eq (S m) (n + 1).
    rewrite Nat.div_add; lia.
Qed.

Lemma div_mod_pos {n m: nat} : S m / (1 + n) + S m mod (1 + n) <> 0.
Proof.
  move=> ?.
  have /Nat.div_small_iff : S m / (1 + n) = 0 by lia. move /(_ ltac:(lia)).
  have /Nat.div_exact : S m mod (1 + n) = 0 by lia. move /(_ ltac:(lia)).
  by lia.
Qed.

Lemma divides_frac_diff {m n} : m mod (n + 1) = 0 -> (m * (n + 2) / (n + 1) - m) * (1 + n) = m.
Proof.
  rewrite Nat.mul_sub_distr_r.
  move=> /Nat.div_exact => /(_ ltac:(lia)) ?.
  have -> : m * (n + 2) = ((n+2) * (m / (n + 1))) * (n + 1) by lia.
  by rewrite Nat.div_mul; lia.
Qed.

Lemma div_mul_le m n : (m / n) * n <= m.
Proof. have := Nat.div_mod_eq m n. by lia. Qed.

Lemma transition_le_gt (f: nat -> nat) (x n1 n2: nat):
  n1 <= n2 -> f n1 <= x -> x < f n2 -> exists n, n < n2 /\ f n <= x /\ x < f (1+n).
Proof.
  move=> H Hfn1 Hfn2. have : n1 < n2.
  { suff : n1 <> n2 by lia. by move=> ?; subst; lia. }
  clear H. elim: n2 Hfn2; first by lia.
  move=> n2 IH ??.
  have [?|?] : f n2 <= x \/ x < f n2 by lia.
  - exists n2 => /=. lia.
  - have ? : n1 <> n2 by (move=> ?; subst; lia).
    have [n ?] := IH ltac:(lia) ltac:(lia).
    exists n. lia.
Qed.


Require Import List.
Import ListNotations.
Require Import StructTact.StructTactics.
Require Import StructTact.Util.
Require Import OrderedType.

Set Implicit Arguments.

Fixpoint fin (n : nat) : Type :=
  match n with
    | 0 => False
    | S n' => option (fin n')
  end.

Fixpoint fin_eq_dec (n : nat) : forall (a b : fin n), {a = b} + {a <> b}.
  refine match n with
    | 0 => fun a b : fin 0 => right (match b with end)
    | S n' => fun a b : fin (S n') =>
               match a, b with
                 | Some a', Some b' =>
                   match fin_eq_dec n' a' b' with
                     | left _ H => left _
                     | right _ H => right _
                   end
                 | Some a', None => right _
                 | None, Some b' => right _
                 | None, None => left _
               end
  end; congruence.
Defined.

Fixpoint all_fin (n : nat) : list (fin n) :=
  match n with
    | 0 => []
    | S n' => None :: map (fun x => Some x) (all_fin n')
  end.

Lemma all_fin_all :
  forall n (x : fin n),
    In x (all_fin n).
Proof using.
  induction n; intros.
  - solve_by_inversion.
  - simpl in *. destruct x; auto using in_map.
Qed.

Lemma all_fin_NoDup :
  forall n, NoDup (all_fin n).
Proof using.
  induction n; intros; simpl; constructor.
  - intro. apply in_map_iff in H. firstorder. discriminate.
  - apply NoDup_map_injective; auto. congruence.
Qed.

Fixpoint fin_to_nat {n : nat} : fin n -> nat :=
  match n with
  | 0 => fun x : fin 0 => match x with end
  | S n' => fun x : fin (S n') =>
             match x with
             | None => 0
             | Some y => S (fin_to_nat y)
             end
  end.

Definition fin_lt {n : nat} (a b : fin n) : Prop := lt (fin_to_nat a) (fin_to_nat b).

Lemma fin_lt_Some_elim :
  forall n (a b : fin n),
    @fin_lt (S n) (Some a) (Some b) -> fin_lt a b.
Proof using.
  intros.
  unfold fin_lt. simpl.
  intuition.
Qed.

Lemma fin_lt_Some_intro :
  forall n (a b : fin n),
    fin_lt a b -> @fin_lt (S n) (Some a) (Some b).
Proof using.
  intros.
  unfold fin_lt. simpl.
  intuition.
Qed.

Lemma None_lt_Some :
  forall n (x : fin n),
    @fin_lt (S n) None (Some x).
Proof using.
  unfold fin_lt. simpl. auto with *.
Qed.

Lemma fin_lt_trans :
  forall n (x y z : fin n),
    fin_lt x y -> fin_lt y z -> fin_lt x z.
Proof using.
  induction n; intros.
  - destruct x.
  - destruct x, y, z; simpl in *;
    repeat match goal with
    | [ H : fin_lt (Some _) (Some _) |- _ ] => apply fin_lt_Some_elim in H
    | [ |- fin_lt (Some _) (Some _) ] => apply fin_lt_Some_intro
    end; eauto using None_lt_Some; solve_by_inversion.
Qed.

Lemma fin_lt_not_eq :
  forall n (x y : fin n),
    fin_lt x y -> x <> y.
Proof using.
  induction n; intros.
  - destruct x.
  - destruct x, y;
    repeat match goal with
    | [ H : fin_lt (Some _) (Some _) |- _ ] => apply fin_lt_Some_elim in H
    | [ |- fin_lt (Some _) (Some _) ] => apply fin_lt_Some_intro
    end; try congruence.
    + specialize (IHn f f0). concludes. congruence.
    + solve_by_inversion.
Qed.

Fixpoint fin_compare (n : nat) : forall (x y : fin n), Compare fin_lt eq x y :=
  match n with
    | 0 => fun x y : fin 0 => match x with end
    | S n' => fun x y : fin (S n') =>
               match x, y with
                 | Some x', Some y' =>
                   match fin_compare n' x' y' with
                     | LT pf => LT (fin_lt_Some_intro pf)
                     | EQ pf => EQ (f_equal _ pf)
                     | GT pf => GT (fin_lt_Some_intro pf)
                   end
                 | Some x', None => GT (None_lt_Some n' x')
                 | None, Some y' => LT (None_lt_Some n' y')
                 | None, None => EQ eq_refl
               end
  end.

Module Type NatValue.
  Parameter n : nat.
End NatValue.

Module fin_OT_compat (N : NatValue) <: OrderedType.
  Definition t := fin N.n.
  Definition eq : t -> t -> Prop := eq.
  Definition lt : t -> t -> Prop := fin_lt.
  Definition eq_refl : forall x : t, eq x x := @eq_refl _.
  Definition eq_sym : forall x y: t, eq x y -> eq y x := @eq_sym _.
  Definition eq_trans : forall x y z : t, eq x y -> eq y z -> eq x z := @eq_trans _.
  Definition lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z := @fin_lt_trans N.n.
  Definition lt_not_eq : forall x y : t, lt x y -> ~ eq x y := @fin_lt_not_eq N.n.
  Definition compare : forall x y : t, Compare lt eq x y := fin_compare N.n.
  Definition eq_dec : forall x y : t, {eq x y} + {~ eq x y} := fin_eq_dec N.n.
End fin_OT_compat.

Require Import Orders.

Lemma fin_lt_irrefl :
  forall n, Irreflexive (@fin_lt n).
Proof using.
  intros.
  unfold Irreflexive, complement, Reflexive, fin_lt.
  intuition.
Qed.

Lemma fin_lt_strorder : forall n, StrictOrder (@fin_lt n).
Proof using.
  intros.
  apply (Build_StrictOrder _ (@fin_lt_irrefl n) (@fin_lt_trans n)).
Qed.

Lemma fin_lt_lt_compat :
  forall n, Proper (eq ==> eq ==> iff) (@fin_lt n).
Proof using.
  intros; split; intros; repeat find_rewrite; assumption.
Qed.

Lemma CompSpec_Eq_Some :
  forall n' (x' y' : fin n'),
    CompSpec eq fin_lt x' y' Eq ->
    Some x' = Some y'.
Proof using.
  intros.
  apply f_equal.
  solve_by_inversion.
Qed.

Lemma CompSpec_Lt :
  forall n' (x' y' : fin n'),
    CompSpec eq fin_lt x' y' Lt ->
    fin_lt x' y'.
Proof using.
  intros.
  solve_by_inversion.
Qed.

Lemma CompSpec_Gt :
  forall n' (x' y' : fin n'),
    CompSpec eq fin_lt x' y' Gt ->
    fin_lt y' x'.
Proof using.
  intros.
  solve_by_inversion.
Qed.

Fixpoint fin_comparison_dec (n : nat) :
  forall (x y : fin n), { cmp : comparison | CompSpec eq fin_lt x y cmp } :=
  match n with
    | 0 => fun x y : fin 0 => match x with end
    | S n' => fun x y : fin (S n') =>
             match x, y with
               | Some x', Some y' =>
                 match fin_comparison_dec n' x' y' with
                   | exist _ Lt Hc => exist _ Lt (CompLt _ _ (fin_lt_Some_intro (CompSpec_Lt Hc)))
                   | exist _ Eq Hc => exist _ Eq (CompEq _ _ (CompSpec_Eq_Some Hc))
                   | exist _ Gt Hc => exist _ Gt (CompGt _ _ (fin_lt_Some_intro (CompSpec_Gt Hc)))
                 end
               | Some x', None => exist _ Gt (CompGt _ _ (None_lt_Some n' x'))
               | None, Some y' => exist _ Lt (CompLt _ _ (None_lt_Some n' y'))
               | None, None => exist _ Eq (CompEq _ _ eq_refl)
             end
  end.

Definition fin_comparison (n : nat) (x y : fin n) : comparison :=
match fin_comparison_dec n x y with exist _ cmp _ => cmp end.

Lemma fin_compare_spec : forall (n : nat) (x y : fin n),
    CompSpec eq fin_lt x y (fin_comparison n x y).
Proof using.
  intros.
  unfold fin_comparison.
  break_match.
  assumption.
Qed.

Module fin_OT (N : NatValue) <: OrderedType.
  Definition t := fin N.n.
  Definition eq := eq (A := fin N.n).
  Definition eq_equiv := eq_equivalence (A := fin N.n).
  Definition lt := fin_lt (n := N.n).
  Definition lt_strorder := fin_lt_strorder N.n.
  Definition lt_compat := fin_lt_lt_compat N.n.
  Definition compare := fin_comparison N.n.
  Definition compare_spec := fin_compare_spec N.n.
  Definition eq_dec := fin_eq_dec N.n.
End fin_OT.

Fixpoint fin_of_nat (m n : nat) : fin n + {exists p, m = n + p} :=
  match n as n0 return fin n0 + {exists p, m = n0 + p} with
  | 0 => inright (ex_intro _ m eq_refl)
  | S n' =>
    match m as m0 return fin (S n') + {exists p, m0 = (S n') + p} with
    | 0 => inleft None
    | S m' =>
      match fin_of_nat m' n' with
      | inleft f => inleft (Some f)
      | inright pf => inright (let 'ex_intro _ x H := pf in
                              ex_intro _ x (f_equal S H))
      end
    end
  end.

Lemma fin_of_nat_fin_to_nat:
  forall (n : nat) (a : fin n), fin_of_nat (fin_to_nat a) n = inleft a.
Proof using.
  induction n; simpl; intuition.
  destruct a; simpl in *; auto.
  now rewrite IHn.
Qed.


Require Import Common.

Module MyList.
  Inductive list (A : Type) : Type :=
  | nil : list A
  | cons : A -> list A -> list A.
  Arguments nil {_}.

  Notation "[ ]" := nil (format "[ ]").
  Notation "x :: xs" := (cons x xs).
  Notation "[ x ]" := (cons x nil).
  Notation "[ x ; y ; .. ; z ]" :=  (cons x (cons y .. (cons z nil) ..)).

  Fixpoint app A (xs ys : list A) : list A :=
    match xs with
    | [] => ys
    | x :: xs => x :: app xs ys
    end.

  Notation "xs ++ ys" := (app xs ys) (right associativity, at level 60).

  Lemma app_nil_r : forall A (xs : list A), xs ++ [] = xs.
  Proof.
    induction xs.
    - simpl.
      reflexivity.
    - simpl.
      rewrite IHxs.
      reflexivity.
  Qed.

  Lemma app_assoc : forall A (xs ys zs : list A), (xs ++ ys) ++ zs = xs ++ (ys ++ zs).
  (* Detailed paper proof.
     By induction on xs.
     - xs is nil,
         goal is forall ys zs, ([] ++ ys) ++ zs = [] ++ (ys ++ zs).
       let ys and zs be arbitrary,
         goal is ([] ++ ys) ++ zs = [] ++ (ys ++ zs).
       ([] ++ ys) computes to ys; [] ++ (ys ++ zs) computes to ys ++ zs.
         goal is ys ++ zs = ys ++ zs.
       conclude by reflexivity.
     - xs is x :: xs,
         goal is forall ys zs, ((x :: xs) ++ ys) ++ zs = (x :: xs) ++ (ys ++ zs)
         IH is forall ys zs, (xs ++ ys) ++ zs = xs ++ (ys ++ zs)
       let ys and zs be arbitrary.
         goal is ((x :: xs) ++ ys) ++ zs = (x :: xs) ++ (ys ++ zs)
       (x :: xs) ++ ys computes to x :: (xs ++ ys)
         goal is (x :: (xs ++ ys)) ++ zs = (x :: xs) ++ (ys ++ zs)
       (x :: (xs ++ ys)) ++ zs computes to x :: ((xs ++ ys) ++ zs)
         goal is x :: ((xs ++ ys) ++ zs) = (x :: xs) ++ (ys ++ zs)
       (x :: xs) ++ (ys ++ zs) computes to x :: (xs ++ (ys ++ zs))
         goal is x :: ((xs ++ ys) ++ zs) = x :: (xs ++ (ys ++ zs))
       use IH instantiated with (ys := ys) and (zs := zs)
       and conclude by reflexivity
   *)
  Proof.
    induction xs as [|x xs].
    - (* xs is [] *)
      intros ys zs.
      simpl.
      reflexivity.
    - (* xs is x :: xs *)
      intros ys zs.
      simpl.
      rewrite IHxs.
      reflexivity.
  Qed.

  Fixpoint rev A (xs : list A) : list A :=
    match xs with
    | [] => []
    | x :: xs => rev xs ++ [x]
    end.

  Fixpoint rev_tail' A (xs : list A) (acc : list A) : list A :=
    match xs with
    | [] => acc
    | x :: xs => rev_tail' xs (x :: acc)
    end.

  Definition rev_tail A (xs : list A) : list A := rev_tail' xs [].

  Theorem rev_is_rev_tail :
    forall A (xs : list A),
      rev_tail xs = rev xs.
  Proof.
    induction xs.
    - simpl. unfold rev_tail. simpl. reflexivity.
    - simpl. unfold rev_tail. simpl. (* ? *) rewrite <- IHxs. (* ??? *)
  Abort.

  (* Rule of thumb: if a function is a fixpoint, statements about it should be
     proved by induction. If it's a definition, induction is unlikely to be
     effective.

     Since rev_tail is a definition, theorems about it should just unfold it and
     then use some lemma about rev_tail'.

     Since rev_tail' is a fixpoint, statements about it should be proved by
     induction.
   *)

  (* There are three flavors of argument to a fixpoint:
     1) the "structural" argument (the one being recursed on)
     2) "constant" arguments, which don't change through any recursive calls
     3) "variable" arguments, which change on recursive calls

     Rule of thumb: in order for a statement about a fixpoint to be provable by
     induction, the structural and variable arguments should be
     forall-quantified.

     Pro tip: the structural argument should be quantified before *any*
     variable arguments.
   *)

  (* So, we're looking for a stament about rev_tail' that forall-quantifies
     over `xs` and `acc`, and which implies `rev_is_rev_tail`. Something
     like this:

     forall A (xs : list A) acc,
        rev_tail' xs acc = (* ??? *)

     How would you describe the general behavior of `rev_tail'`? You might say
     something like "it reverses `xs` and prepends the result to `acc`". This
     turns out to work!
   *)

  Lemma rev_tail'_is_rev_then_prepend :
    forall A (xs acc : list A),
      rev_tail' xs acc = rev xs ++ acc.
  (* Detailed paper proof:
     By induction on xs.
     - x is [],
         goal becomes forall acc, rev_tail [] acc = rev [] ++ acc.
       let acc be arbitrary,
         goal becomes rev_tail [] acc = rev [] ++ acc.
       rev_tail [] acc computes to acc,
         goal becomes acc = rev [] ++ acc.
       rev [] computes to [],
         goal becomes acc = [] ++ acc.
       [] ++ acc computes to acc,
         goal becomes acc = acc.
       conclude by reflexivity.
     - xs is x :: xs,
         goal becomes forall acc, rev_tail (x :: xs) acc = rev (x :: xs) ++ acc.
         IH is forall acc, rev_tail xs acc = rev xs ++ acc.
       let acc be arbitrary,
         goal becomes rev_tail (x :: xs) acc = rev (x :: xs) ++ acc.
       rev_tail (x :: xs) acc computes to rev_tail xs (x :: acc)
         goal becomes rev_tail xs (x :: acc) = rev (x :: xs) ++ acc.
       rev (x :: xs) computes to rev xs ++ [x]
         goal becomes rev_tail xs (x :: acc) = (rev xs ++ [x]) ++ acc.
       instantiate IH with (x :: acc)
         IH becomes rev_tail xs (x :: acc) = rev xs ++ x :: acc.
       use IH in goal,
         goal becomes rev xs ++ x :: acc = (rev xs ++ [x]) ++ acc.
       use associativity of append (lemma)
         goal becomes rev xs ++ x :: acc = rev xs ++ ([x] ++ acc).
       [x] ++ acc computes to x :: acc,
         goal becomes rev xs ++ x :: acc = rev xs ++ x :: acc.
       conclude by reflexivity. *)
  Proof.
    induction xs as [|x xs].
    - intros acc.
      simpl.
      reflexivity.
    - intros acc.
      simpl.
      specialize (IHxs (x :: acc)).
      rewrite IHxs.
      rewrite app_assoc.
      simpl.
      reflexivity.
  Qed.

  Theorem rev_tail_is_rev :
    forall A (xs : list A),
      rev_tail xs = rev xs.
  Proof.
    unfold rev_tail.
    intros.
    rewrite rev_tail'_is_rev_then_prepend.
    rewrite app_nil_r.
    reflexivity.
  Qed.

  (* Proof engineering tip: unfold at most one definition per theorem.

     Even better: rely on computational behavior of at most one definition per
     theorem.
   *)
End MyList.

(* Switch back to stdlib lists and nats, since what we're about to do isn't
   there already. *)
Require Import List.
Import ListNotations.

Fixpoint sum (xs : list nat) : nat :=
  match xs with
  | [] => 0
  | x :: xs => x + sum xs
  end.

Fixpoint sum_tail' (xs : list nat) (acc : nat) : nat :=
  match xs with
  | [] => acc
  | x :: xs => sum_tail' xs (x + acc)
  end.

Definition sum_tail (xs : list nat) : nat := sum_tail' xs 0.

Theorem sum_tail_is_sum :
  forall xs, sum_tail xs = sum xs.
Proof.
  induction xs.
  - simpl. unfold sum_tail. simpl. reflexivity.
  - simpl. unfold sum_tail. simpl.
Abort.

Lemma sum_tail'_is_sum_plus_acc :
  forall xs acc, sum_tail' xs acc = sum xs + acc.
Proof.
  induction xs.
  - intros acc.
    simpl.
    reflexivity.
  - intros acc.
    simpl.
    rewrite IHxs.
    omega.
Qed.

Theorem sum_tail_is_sum :
  forall xs, sum_tail xs = sum xs.
Proof.
  intros xs.
  unfold sum_tail.
  rewrite sum_tail'_is_sum_plus_acc.
  omega.
Qed.

Fixpoint sum_cps' (xs : list nat) A (k : nat -> A) : A :=
  match xs with
  | [] => k 0

  (* See what happens if you change x + n to n + x in the following line.

     Nothing too bad, but the proof below breaks because we need an extra
     commutativity step. Carefully designed to make proofs simple. This is
     something that will come up again and again. *)
  | x :: xs => sum_cps' xs (fun n => k (x + n))
  end.

Definition sum_cps (xs : list nat) : nat := sum_cps' xs (fun x => x).

(* TODO: probably worth getting stuck here when attempting to fix k as fun x => x. *)

Lemma sum_cps'_calls_k_with_sum :
  forall xs A (k : nat -> A),
    sum_cps' xs k = k (sum xs).
Proof.
  induction xs.
  - intros.
    simpl.
    reflexivity.
  - intros.
    simpl.
    rewrite IHxs.
    reflexivity.
Qed.

Theorem sum_cps_is_sum :
  forall xs, sum_cps xs = sum xs.
Proof.
  intros.
  unfold sum_cps.
  rewrite sum_cps'_calls_k_with_sum.
  reflexivity.
Qed.

Inductive expr :=
| Const (n : nat)
| Plus (e1 e2 : expr).

Fixpoint eval (e : expr) : nat :=
  match e with
  | Const n => n
  | Plus e1 e2 => eval e1 + eval e2
  end.

Fixpoint eval_cps' (e : expr) A (k : nat -> A) : A :=
  match e with
  | Const n => k n

  (* Change n1 + n2 to n2 + n1 for a good time. *)
  | Plus e1 e2 => eval_cps' e1 (fun n1 => eval_cps' e2 (fun n2 => k (n1 + n2)))
  end.

Definition eval_cps (e : expr) : nat := eval_cps' e (fun x => x).

Lemma eval_cps'_calls_k_with_eval :
  forall e A (k : nat -> A),
    eval_cps' e k = k (eval e).
Proof.
  induction e.
  - intros.
    simpl.
    reflexivity.
  - intros.
    simpl.
    rewrite IHe1.
    rewrite IHe2.
    reflexivity.
Qed.

Theorem eval_cps_is_eval : forall e, eval_cps e = eval e.
Proof.
  intros.
  unfold eval_cps.
  rewrite eval_cps'_calls_k_with_eval.
  reflexivity.
Qed.

(* Stack machine *)

Inductive instr :=
| Push (n : nat)
| Add.

Definition prog := list instr.

Definition stack := list nat.

Definition exec_instr (i : instr) (s : stack) : stack :=
  match i with
  | Push n => n :: s
  | Add => match s with
          | x :: y :: s => y + x :: s (* forth order *)
          | _ => s (* bogus!

                     TODO: interesting point here about doing a type-correct but
                     wrong thing vs introducing options to capture failure;
                     corresponding proof engineering tradeoffs *)
          end
  end.

Fixpoint exec_prog' (p : prog) (s : stack) : stack :=
  match p with
  | [] => s
  | i :: p => exec_prog' p (exec_instr i s)
  end.

Definition exec_prog (p : prog) : nat := hd 0 (exec_prog' p []).
(* TODO: Could also return stack here. jrw thinks stack is right thing, but also
   that readers won't agree :) But returning nat has advantage of making things
   a little harder. *)

Fixpoint compile (e : expr) : prog :=
  match e with
  | Const n => [Push n]
  | Plus e1 e2 => compile e1 ++ compile e2 ++ [Add]
  end.

Theorem compile_correct :
  forall e,
    exec_prog (compile e) = eval e.
Proof.
  (* TODO: get stuck*)
Abort.

(* Nothing obviously wrong with this lemma statement.

   TODO: Brings up interesting discussion of rule of thumb, since we're
   forall-quantified over e, but then call compile, instead of just being
   forall-quantified over a program. *)
Lemma exec_prog'_of_compile_is_push_eval :
  forall e s,
    exec_prog' (compile e) s = eval e :: s.
Proof.
  induction e.
  - intros.
    simpl.
    reflexivity.
  - intros.
    simpl.
    Fail rewrite IHe1. (* oh no! *)
    (* We need to know that exec_prog' executes appends in the right way.
       Two reasonable ways of proceeding: prove exec_prog'_app lemma or
       generalize current lemma statement to account for it. Showing both
       is interesting. *)

    Lemma exec_prog'_app :
      forall p1 p2 s,
        exec_prog' (p1 ++ p2) s = exec_prog' p2 (exec_prog' p1 s).
    Proof.
      induction p1.
      - intros.
        simpl.
        reflexivity.
      - intros.
        simpl.
        rewrite IHp1.
        reflexivity.
    Qed.

    rewrite exec_prog'_app.
    rewrite IHe1.

    rewrite exec_prog'_app.
    rewrite IHe2.
    simpl. (* Notice we can skip the error case. *)
    reflexivity.
Qed.

Theorem compile_correct :
  forall e,
    exec_prog (compile e) = eval e.
Proof.
  unfold exec_prog.
  intros.
  rewrite exec_prog'_of_compile_is_push_eval.
  simpl. (* Notice we can skip the error case. *)
  reflexivity.
Qed.

(* Other way of doing it in one go. *)
Lemma exec_prog'_of_compile_of_e_appended_to_p_is_exec_prog'_of_p_with_eval_e_pushed :
  forall e p s,
    exec_prog' (compile e ++ p) s = exec_prog' p (eval e :: s).
Proof.
  induction e.
  - intros.
    simpl.
    reflexivity.
  - intros.
    simpl.
    rewrite app_ass.
    rewrite IHe1.
    rewrite app_ass.
    rewrite IHe2.
    simpl.
    reflexivity.
Qed.

Theorem compile_correct_another_way :
  forall e,
    exec_prog (compile e) = eval e.
Proof.
  intros.
  unfold exec_prog.
  rewrite <- app_nil_r with (l := compile e).
  rewrite exec_prog'_of_compile_of_e_appended_to_p_is_exec_prog'_of_p_with_eval_e_pushed.
  simpl.
  reflexivity.
Qed.

(* Insertion sort *)

(* TODO: Discussion of spec for sorting. Usually if you ask people who haven't
   thought about it before, they will say "well it should be sorted" and not
   remember to say permutation. *)

Fixpoint insert (a : nat) (xs : list nat) : list nat :=
  match xs with
  | [] => [a]
  | x :: xs => if a <=? x then a :: x :: xs
              else x :: (insert a xs)
  end.

(* Just for fun... *)
Fixpoint insert_tail' (a : nat) (xs acc : list nat) : list nat :=
  match xs with
  | [] => List.rev' (a :: acc)
  | x :: xs => if a <=? x then List.rev_append acc (a :: x :: xs)
              else insert_tail' a xs (x :: acc)
  end.

Definition insert_tail (a : nat) (xs : list nat) : list nat :=
  insert_tail' a xs [].

(* :D *)
Lemma insert_tail'_is_prepend_reversed_acc_to_insert_xs :
  forall a xs acc,
    insert_tail' a xs acc = List.rev acc ++ insert a xs.
Proof.
  induction xs.
  - intros.
    simpl.
    unfold rev'.
    simpl.
    rewrite rev_append_rev.
    simpl.
    reflexivity.
  - intros.
    simpl.
    break_if.
    + rewrite rev_append_rev.
      reflexivity.
    + rewrite IHxs.
      simpl.
      rewrite app_ass.
      simpl.
      reflexivity.
Qed.

Theorem insert_tail_is_insert :
  forall a xs,
    insert_tail a xs = insert a xs.
Proof.
  intros.
  unfold insert_tail.
  rewrite insert_tail'_is_prepend_reversed_acc_to_insert_xs.
  simpl.
  reflexivity.
Qed.

Lemma insert_insert_comm :
  forall a b xs,
    insert a (insert b xs) = insert b (insert a xs).
Proof.
  induction xs.
  - simpl.
    repeat break_if.
    + rewrite Nat.leb_le in *.
      assert (a = b) by omega.
      subst.
      reflexivity.
    + reflexivity.
    + reflexivity.
    + rewrite Nat.leb_nle in *.
      omega.
  - simpl.
    repeat (break_if; simpl).
    all: try rewrite Nat.leb_le in *.
    all: try rewrite Nat.leb_nle in *.
    all: auto.
    all: try omega.
    all: try discriminate.
    + assert (a = b) by omega.
      subst.
      reflexivity.
    + rewrite IHxs.
      reflexivity.
Qed.

Fixpoint insertion_sort (xs : list nat) : list nat :=
  match xs with
  | [] => []
  | x :: xs => insert x (insertion_sort xs)
  end.

Fixpoint insertion_sort_tail' (xs acc : list nat) : list nat :=
  match xs with
  | [] => acc
  | x :: xs => insertion_sort_tail' xs (insert_tail x acc)
  end.

Definition insertion_sort_tail (xs : list nat) : list nat :=
  insertion_sort_tail' xs [].

Theorem insertion_sort_tail_is_insertion_sort :
  forall xs,
    insertion_sort_tail xs = insertion_sort xs.
Proof.
  intros.
  unfold insertion_sort_tail.
  induction xs.
  - simpl.
    reflexivity.
  - simpl.
    rewrite <- IHxs.
    rewrite insert_tail_is_insert.

    Lemma insertion_sort_tail'_insert_comm :
      forall xs a ys,
        insertion_sort_tail' xs (insert a ys) = insert a (insertion_sort_tail' xs ys).
    Proof.
      induction xs.
      - intros.
        simpl.
        reflexivity.
      - intros.
        simpl.
        rewrite insert_tail_is_insert.
        rewrite insert_tail_is_insert.
        rewrite insert_insert_comm.
        rewrite IHxs.
        reflexivity.
    Qed.

    rewrite insertion_sort_tail'_insert_comm.
    reflexivity.
Qed.

(* Roll our own sorted because it's a good exercise and the stdlib is more
   general than we need. *)
Inductive sorted : list nat -> Prop :=
| sorted_nil : sorted []
| sorted_cons : forall a xs, sorted xs -> List.Forall (fun x => a <= x) xs -> sorted (a :: xs).

Theorem insertion_sort_sorted :
  forall xs, sorted (insertion_sort xs).
Proof.
  induction xs.
  - simpl.
    apply sorted_nil.
  - simpl.

    Lemma insert_sorted :
      forall a xs,
        sorted xs ->
        sorted (insert a xs).
    Proof.
      induction xs.
      - intros.
        simpl.
        apply sorted_cons.
        + apply sorted_nil.
        + apply Forall_nil.
      - intros.
        simpl.
        break_if.
        + rewrite Nat.leb_le in *.
          apply sorted_cons.
          * assumption.
          * invc H.
            apply Forall_cons.
            -- assumption.
            -- eapply Forall_impl; try eassumption.
               intros.
               simpl in *.
               omega.
        + rewrite Nat.leb_nle in *.
          invc H.
          apply sorted_cons.
          * apply IHxs. assumption.
          *
            Lemma insert_Forall_le:
              forall (a b : nat) (xs : list nat),
                a <= b ->
                Forall (fun x : nat => a <= x) xs -> Forall (fun x : nat => a <= x) (insert b xs).
            Proof.
              intros.
              (* Pro tip: induct on the Forall instead of the xs. In general,
                 induct on the "most dependent" thing you have. *)
              induction H0.
              - simpl.
                apply Forall_cons.
                + assumption.
                + apply Forall_nil.
              - simpl.
                break_if.
                + apply Forall_cons.
                  * assumption.
                  * apply Forall_cons.
                    -- assumption.
                    -- assumption.
                + apply Forall_cons.
                  * assumption.
                  * assumption.
            Qed.

            apply insert_Forall_le.
            -- omega.
            -- assumption.
    Qed.

    apply insert_sorted.
    assumption.
Qed.

(* The permutation library is pretty good already, so we can just use it directly. *)

Require Import Permutation.

Theorem insertion_sort_perm :
  forall xs, Permutation (insertion_sort xs) xs.
Proof.
  induction xs.
  - simpl.
    reflexivity.
  - simpl.

    Lemma insert_perm :
      forall a xs, Permutation (insert a xs) (a :: xs).
    Proof.
      induction xs.
      - simpl.
        reflexivity.
      - simpl.
        break_if.
        + reflexivity.
        + (* Pro tip: rewriting with Permutations works and is typically more
             convenient than trying to apply lemmas directly. *)
          rewrite perm_swap.
          apply Permutation_cons.
          * reflexivity.
          * apply IHxs.
    Qed.

    rewrite insert_perm.
    apply Permutation_cons.
    + reflexivity.
    + apply IHxs.
Qed.

(* We have proved that insertion_sort is correct (sorted and permutation) and
   that insertion_sort_tail (which is the code we actually want to run) is
   equivalent to it. We can combine these to get correctness of
   insertion_sort_tail. *)

Theorem insertion_sort_tail_sorted :
  forall xs, sorted (insertion_sort_tail xs).
Proof.
  intros.
  rewrite insertion_sort_tail_is_insertion_sort.
  apply insertion_sort_sorted.
Qed.

Theorem insertion_sort_tail_perm :
  forall xs, Permutation (insertion_sort_tail xs) xs.
Proof.
  intros.
  rewrite insertion_sort_tail_is_insertion_sort.
  apply insertion_sort_perm.
Qed.


Require Import Frap Helpers.

Require Import Problem.

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

Theorem fact_thm1:
  fact 5 = 120.
Proof.
  simplify.
  equality.
Qed.

Theorem fact_thm2: forall (n: nat),
  n > 1 -> (exists (k: nat), fact n = 2 * k).
Proof.
  simplify.
  induct n.
  * linear_arithmetic.
  * cases (n =? 1).
    - comparison_bool_to_prop.
      rewrite Heq.
      simplify.
      exists 1.
      linear_arithmetic.
    - comparison_bool_to_prop.
      assert (n > 1) by linear_arithmetic.
      propositional.
      clear H Heq H0.
      invert H1.
      exists (x * S n).
      simplify.
      rewrite H.
      ring.
Qed.

Fixpoint fact_CPS (n: nat) (C: nat -> nat): nat :=
  match n with
  | 0 => C 1
  | S n' => fact_CPS n' (fun R => C (n * R))
  end.

Theorem CPS_correct: forall (n: nat) (f: nat -> nat),
 fact_CPS n f = f (fact n).
Proof.
  induct n; simplify.
  + trivial.
  + apply IHn with (f := fun R: nat => f ( S n * R )).
Qed.

Theorem fact_CPS_thm2: forall (n: nat),
  n > 1 -> (exists (k: nat), fact_CPS n (fun R => R) = 2 * k).
Proof.
  simplify.
  rewrite CPS_correct.
  apply fact_thm2.
  assumption.
Qed.


Require Import aula3 aula4.
(** Prove the following claim, marking cases (and subcases) with
    bullets when you use [destruct]. *)

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

(** **** Exercise: 1 star (zero_nbeq_plus_1)  *)
Theorem zero_nbeq_plus_1 : forall n : nat,
  beq_nat 0 (n + 1) = false.
Proof.
 intros n. destruct n.
 - simpl. reflexivity.
 - simpl. reflexivity.
 Qed.

(** **** Exercise: 2 stars (boolean_functions)  *)
(** Use the tactics you have learned so far to prove the following
    theorem about boolean functions. *)

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

(** **** Exercise: 3 stars, optional (andb_eq_orb)  *)
(** Prove the following theorem.  (Hint: This one can be a bit tricky,
    depending on how you approach it.  You will probably need both
    [destruct] and [rewrite], but destructing everything in sight is
    not the best way.) *)

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


Set Implicit Arguments.    (* Allows us to use inference for dependent arguments *)

Require Import Reals.      (* Imports real arithmetic. *)
Delimit Scope R with Real.    (* Notice: due to the absence of overloading, from this *)
                           (* point on constants and operators are real-typed,     *)
Notation Real := R.           (* unless stated otherwise with the scope indicator '%' *)

Check 3 + 4.           (* : ℕ  (nat)  *)
Check (3 + 4) % R.     (* : ℝ  (Real) *)

Inductive Vec : nat -> Set :=
  VNil : Vec 0
| VCons : forall n, Real -> Vec n -> Vec (S n).

(* Some syntactic sugar *)
Notation "<< x , .. , y >>" := (VCons x .. (VCons y VNil) .. ).

Check << 5, 9, 6 >> .

Check VCons.
Print Implicit VCons.

Fail Definition c1 := repeat 1.
Definition c2 n := VCons (n:=n) 2.

Fixpoint repeat e n :=
  match n with
    0 => VNil
  | S k => VCons e (repeat e k)
  end.

Check repeat.

Compute repeat 4 5.
Eval simpl in repeat 4 5.

Check nat_rec.

Definition repeat' e :=
  nat_rec Vec VNil (fun x y => VCons e y).

Eval simpl in repeat' 4 5.

Check Vec_rec.

(* Notice that a return type is needed here *)
Fixpoint concat m n (v1 : Vec m) (v2 : Vec n) : Vec (m+n):=
  match v1 with
    VNil => v2
  | VCons x xs => VCons x (concat xs v2)
  end.

Definition ifz n (t1 t2 : Type) := match n with
                                   | 0 => t1
                                   | _ => t2 end.

Definition hd' n (v : Vec n) : ifz n unit R :=
  match v with
    VNil => tt
  | VCons x xs => x
  end.

Definition hd n (v : Vec (S n)) := hd' v.

Fixpoint Vec' n : Set :=
  match n with
    0 => unit
  | S k => R * Vec' k
  end.

Fixpoint vec_to_vec' n (v: Vec n) : Vec' n :=
  match v with
    VNil => tt
  | VCons x xs => (x, vec_to_vec' xs)
  end.

Fixpoint inner_product' n : Vec' n -> Vec' n -> Real :=
  match n with
    0 => fun _ _ => 0
  | S k => fun v1 v2 =>
            match v1, v2 with
              (x, xs), (y, ys) =>
              x * y + inner_product' k xs ys
            end
  end.

Fixpoint inner_product n (v1 v2 : Vec n) :=
  inner_product' n (vec_to_vec' v1) (vec_to_vec' v2).

Print inner_product.

Hint Unfold inner_product.

Example test_inner_product :
  inner_product <<1>> <<4>> = 4.
Proof. field. Qed.

Eval field in inner_product <<1>> <<4>>.

Check inner_product << 5, 9, 6 >> << 1, 3, 7 >>.
Fail Check inner_product << 9, 6 >> << 1, 3, 7 >>.


Require Import Arith Lia.

Record iso (A B : Set) : Set :=
  bijection {
    A_to_B : A -> B;
    B_to_A : B -> A;
    A_B_A  : forall a : A, B_to_A (A_to_B a) = a;
    B_A_B  : forall b : B, A_to_B (B_to_A b) = b
  }.

(* Task 0 : Example of iso in finite sets *)
(* Find a bijection between bool and bit. (provided for you as an example) *)
Inductive bit : Set := b0 | b1.

Definition bool2bit (b : bool) : bit :=
  match b with true => b1 | false => b0
  end.

Definition bit2bool (b : bit) : bool :=
  match b with b1 => true | b0 => false
  end.

Definition bool_iso_bit : iso bool bit.
Proof.
  apply (bijection _ _ bool2bit bit2bool).
  intros.
  case a.
  simpl.
  reflexivity.
  simpl.
  reflexivity.
  intros.
  case b.
  simpl.
  reflexivity.
  simpl.
  reflexivity.
Qed.

(******************************************)
(* Task 1 : General properties of iso *)
(* Task 1-1. Prove that any set has the same cardinality as itself. *)
Theorem iso_refl : forall A : Set, iso A A.
Proof.
  intros.
  apply (bijection _ _ id id);
    unfold id; reflexivity.
  Qed.

(* Task 1-2. Prove that iso is symmetric. *)
Theorem iso_sym : forall A B : Set, iso A B -> iso B A.
Proof.
  intros.
  elim H.
  intros.
  exact (bijection B A B_to_A0 A_to_B0 B_A_B0 A_B_A0).
Qed.

(* Task 1-3. Prove that iso is transitive. *)
Theorem iso_trans : forall A B C : Set, iso A B -> iso B C -> iso A C.
Proof.
  intros.
  case H as [AB BA ABA BAB].
  case H0 as [BC CB BCB CBC].
  apply (bijection A C (fun a => BC (AB a)) (fun c =>  BA (CB c))).
  intros.
  specialize (BCB (AB a)).
  rewrite BCB.
  specialize (ABA a).
  rewrite ABA.
  reflexivity.
  intros.
  specialize (BAB (CB b)).
  rewrite BAB.
  specialize (CBC b).
  rewrite CBC.
  reflexivity.
Qed.

(* Task 1-4. Prove the following statement:
  Given two functions A->B and B->A, if A->B->A is satisfied and B->A is injective, A <=> B. *)
Theorem bijection_alt : forall (A B : Set) (A2B : A -> B) (B2A : B -> A),
  (forall a, B2A (A2B a) = a) -> (forall b1 b2, B2A b1 = B2A b2 -> b1 = b2) -> iso A B.
Proof.
  intros.
  apply (bijection _ _ A2B B2A).
  assumption.
  intros.
  rewrite (H0 (A2B (B2A b)) b).
  reflexivity.
  rewrite (H (B2A b)).
  reflexivity.
Qed.

(******************************************)
(* Task 2 : iso relations between nat and various supersets of nat *)

(* nat_plus_1 : a set having one more element than nat. (provided in preloaded) *)
(* Inductive nat_plus_1 : Set := null | is_nat (n : nat). *)

(* Task 2-1. Prove that nat has the same cardinality as nat_plus_1. *)

Inductive nat_plus_1 : Set := null | is_nat (n : nat).

Theorem nat_iso_natp1 : iso nat nat_plus_1.
Proof.
  apply (bijection _ _ (fun n => match n with
                                | 0 => null
                                | S m => is_nat m
                       end) (fun n => match n with
                                | null => 0
                                | is_nat m => S m
                       end)).
  intros.
  induction a;
  reflexivity.
  induction b;
  reflexivity.
Qed.

(* nat_plus_nat : a set having size(nat) more elements than nat. (provided in preloaded) *)
Inductive nat_plus_nat : Set := left (n : nat) | right (n : nat).

Fixpoint nat_to_nn (n : nat) : nat_plus_nat
  := match n with
       | 0 => left 0
       | 1 => right 0
       | S (S m) => match nat_to_nn m with
                     | left a => left (S a)
                     | right a => right (S a)
                    end
     end.

Definition nn_to_nat (n : nat_plus_nat) : nat
  := match n with
       | left l => l + l
       | right r => S (r + r)
     end.

Definition nat_ind_two : forall P,
  P 0 -> P 1 -> (forall n, P n -> P (S (S n))) -> (forall n, P n).
Proof.
  intros P P0 P1 PSS.
  exact (fix go (n:nat): P n := match n with
    | 0 => P0
    | 1 => P1
    | S (S n_bez_dvou) => PSS n_bez_dvou (go n_bez_dvou)
  end
  ).
Qed.

Definition nat_ind_two2 : forall P,
  P 0 -> P 1 -> (forall n, P n -> P (S (S n))) -> (forall n, P n).
Proof.
  intros P P0 P1 PSS.
  fix IPn 1.
  intro m.
  destruct m.
  exact P0.
  destruct m.
  exact P1.
  apply PSS.
  exact (IPn m).
Qed.

(* Task 2-2. Prove that nat has the same cardinality as nat_plus_nat. *)
Theorem nat_iso_natpnat : iso nat nat_plus_nat.
Proof.
  apply (bijection _ _ nat_to_nn nn_to_nat).
  - intros.
    induction a using nat_ind_two.
    compute. easy.
    compute. easy.
    simpl.
    destruct (nat_to_nn a).
    simpl in IHa.
    simpl.
    lia.
    simpl in IHa.
    simpl.
    lia.
  - intros.
    destruct b.
    simpl.
    induction n.
    compute.
    reflexivity.
    assert (S n + S n = S (S (n + n))) by lia.
    rewrite -> H.
    simpl.
    rewrite -> IHn.
    reflexivity.
    simpl nn_to_nat.
    induction n.
    compute.
    reflexivity.
    simpl.
    assert (n + S n = S (n + n)) by lia.
    rewrite -> H.
    rewrite -> IHn.
    reflexivity.
Qed.


(* 1 *)
Fixpoint ravno (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' => ravno n' m'
                  end
      end.

Eval compute in ravno 5 3.
Eval compute in ravno 5 5.
Eval compute in ravno 5 7.

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

Eval compute in leb 5 3.
Eval compute in leb 5 5.
Eval compute in leb 5 7.

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

Eval compute in leb2 5 3.
Eval compute in leb2 5 5.
Eval compute in leb2 5 7.

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

Eval simpl in evennum 1.
Eval simpl in evennum 6.

(* 5 *)
Definition oddnum (n : nat) : bool :=
       negb (evennum n).

Eval compute in oddnum 1.
Eval compute in oddnum 6.


Inductive day : Type :=
  | monday    : day
  | tuesday   : day
  | wednesday : day
  | thursday  : day
  | friday    : day
  | saturday  : day
  | sunday    : day.

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

Eval compute in (next_weekday friday).

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

Inductive bool : Type :=
  | true  : bool
  | false : bool.

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

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

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

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

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

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

Definition andb3 (b1:bool) (b2:bool) (b3:bool) : bool :=
  match (b1,b2,b3) with
  | (true,true,true) => true
  | _                => false
  end.

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

Check true.
Check negb.

Module Playground1.

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

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

End Playground1.

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

Eval simpl in (minustwo 4).

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

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

Example test_oddb1: (oddb (S O)) = true.
Proof. reflexivity. Qed.
Example test_oddb2: (oddb (S (S (S (S O))))) = false.
Proof. reflexivity. Qed.

Module Playground2.

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

Eval simpl in (plus (S (S (S O))) (S (S O))).

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

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

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

End Playground2.

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

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

Example test_factorial1: (factorial 3) = 6.
Proof. reflexivity. Qed.
Example test_factorial2: (factorial 5) = (mult 10 12).
Proof. reflexivity. Qed.

Notation "x + y" := (plus x y)
                       (at level 50, left associativity)
                       : nat_scope.
Notation "x - y" := (minus x y)
                       (at level 50, left associativity)
                       : nat_scope.
Notation "x * y" := (mult x y)
                       (at level 40, left associativity)
                       : nat_scope.

Check ((0 + 1) + 1).

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

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

Example test_ble_nat1: (ble_nat 2 2) = true.
Proof. reflexivity. Qed.
Example test_ble_nat2: (ble_nat 2 4) = true.
Proof. reflexivity. Qed.
Example test_ble_nat3: (ble_nat 4 2) = false.
Proof. reflexivity. Qed.

Definition blt_nat (n m : nat) : bool :=
  andb (ble_nat n m) (negb (beq_nat n m)).

Example test_blt_nat1: (blt_nat 2 2) = false.
Proof. reflexivity. Qed.
Example test_blt_nat2: (blt_nat 2 4) = true.
Proof. reflexivity. Qed.
Example test_blt_nat3: (blt_nat 4 2) = false.
Proof. reflexivity. Qed.

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

Theorem plus_id_example : forall n m : nat, n = m -> n + n = m + m.
Proof. intros n m. intros H. rewrite -> H. reflexivity. Qed.
Theorem plus_id_exercise: forall n m o : nat,
  n = m -> m = o -> n + m = m + o.
Proof. intros. rewrite -> H. rewrite <- H0. reflexivity. Qed.

Theorem mult_0_plus : forall n m : nat,
  (0 + n) * m = n * m.
Proof.
  intros n m.
  rewrite -> plus_O_n.
  reflexivity. Qed.

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

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

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

Theorem zero_nbeq_plus_1 : forall n : nat,
  beq_nat 0 (n + 1) = false.
Proof.
  intros n.
  destruct n as [|n'].
    reflexivity.
    reflexivity. Qed.

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

Theorem andb_eq_orb_lemma1 :
  forall (c : bool), andb true c = c.
Proof.
  destruct c.
    reflexivity.
    reflexivity. Qed.

Theorem andb_eq_orb_lemma2 :
  forall (c : bool), orb true c = true.
Proof.
  destruct c.
    reflexivity.
    reflexivity. Qed.

Theorem andb_eq_orb_lemma3 :
  forall (c : bool), andb false c = false.
Proof.
  destruct c.
    reflexivity.
    reflexivity. Qed.

Theorem andb_eq_orb_lemma4 :
  forall (c : bool), orb false c = c.
Proof.
  destruct c.
    reflexivity.
    reflexivity. Qed.

Theorem andb_eq_orb :
  forall (b c : bool),
    (andb b c = orb b c) -> b = c.
Proof.
  intros b c.
  destruct b.
    rewrite -> andb_eq_orb_lemma1.
    rewrite -> andb_eq_orb_lemma2.
    intro H.
    rewrite -> H.
    reflexivity.
    rewrite -> andb_eq_orb_lemma3.
    rewrite -> andb_eq_orb_lemma4.
    intro H.
    rewrite -> H.
    reflexivity.
  Qed.

Inductive bin : Type :=
  | Zero  : bin
  | Twice : bin -> bin
  | TwicePlusOne : bin -> bin.

Fixpoint increment_bin (n : bin) : bin :=
  match n with
  | Zero     => TwicePlusOne Zero
  | Twice n' => TwicePlusOne n'
  | TwicePlusOne n' => Twice (increment_bin n')
  end.

Fixpoint convert_to_unary (n : bin) : nat :=
  match n with
  | Zero => 0
  | Twice n' => (convert_to_unary n') + (convert_to_unary n')
  | TwicePlusOne n' => S ((convert_to_unary n') + (convert_to_unary n'))
  end.

Eval compute in convert_to_unary (increment_bin (Twice (Twice (TwicePlusOne Zero)))).

Theorem convert_increment :
  forall (n : bin), S (convert_to_unary n) = convert_to_unary (increment_bin n).
Proof.
  destruct n as [|n'|n'].
    simpl.
    reflexivity.
    simpl.
    reflexivity.
    simpl.
    Admitted.