From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq path.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

(** * Sorting algorithms *)

(** ** Insertion sort *)

Module Insertion.
Section InsertionSort.

Variable T : eqType.
Variable leT : rel T.
Implicit Types x y z : T.
Implicit Types s t u : seq T.

(** Insert an element [e] into a sorted list [s] *)
Fixpoint insert e s : seq T :=
  if s is x :: s' then
    if leT e x then e :: s
    else x :: (insert e s')
  else [:: e].

(** Sort input list [s] *)
Fixpoint sort s : seq T :=
  if s is x :: s' then
    insert x (sort s')
  else [::].

(** Now we'd like to prove [sort] correct.
    But what does mean for a sorting algorithm
    to be correct?

It could have been a requirement that the output
of the algorithm is _sorted_.
Let's give this notation a precise meaning.
We call the corresponding predicate [sorted']
because we will later refine the definition into
something more general that helps us a lot with
inductive proofs.
*)

(** This fails because [x2 :: s'] is not a
    structural subterm of [s] *)
Fail Fixpoint sorted' s : bool :=
  if s is x1 :: x2 :: s' then
    leT x1 x2 && (sorted' (x2 :: s'))
  else true.

Fixpoint sorted' s : bool :=
  if s is x1 :: ((x2 :: s') as tail) then
    leT x1 x2 && (sorted' tail)
  else true.

(** The obvious definition we came up with is not
    very easy to work with.
    We would see it later when trying to prove
    that [insert] function preserves sortedness. *)

(** So instead we are going to use Mathcomp's
    [sorted] predicate, which is based on the notion
    of [path]. *)
Print sorted.
(**
sorted =
fun (T : eqType) (leT : rel T) (s : seq T) =>
if s is x :: s' then path leT x s'
else true
: forall T : Type, rel T -> seq T -> bool
*)

Print path.
(**
path =
fun (T : Type) (e : rel T) =>
fix path (x : T) (p : seq T) {struct p} : bool :=
  if p is (y :: p') then e x y && path y p'
  else true
: forall T : Type, rel T -> T -> seq T -> bool
*)

(** With the modified definition the helper lemma
    is much easier to prove (exercise): *)
Lemma sorted_cons e s :
  sorted leT (e :: s) -> sorted leT s.
Admitted.

(**
It's easy to see that requiring just sortedness
of the output list is a rather weak specification --
a function always returning an empty list would
also be correct

Hence, our next observation --
the function should NOT forget about elements of
the input list:

  forall x : T, x \in s -> x \in (sort s)

A little thinking reveals this is a pretty weak spec:
a function may (in principle) add extra elements
to the output, so we need to disallow that:

  forall x : T, x \in s = x \in (sort s)

Remark:
  Since our implementations are going to be
  parametric (generic), the only way the extra
  elements may occur in the output list is by
  repeating some elements of the input list,
  so the above tweak of the spec does not
  actually buy us anything.

The current version of the spec is still not strong
enough: it does not take into account possible
duplicates in the input list, e.g. the following is
true, while this is not what we meant -- let's assume
s = [:: 0; 0; 0] and that (sort s) = [:: 0; 0],
then the spec above still holds:
  forall x, x \in [:: 0; 0; 0] = x \in [:: 0; 0]

What we actually care about is to keep the elements
together with their repective number of occurences.

  forall x : T,
    count (pred1 x) s = count (pred1 x) (sort s)

Question: what goes wrong if we add a precondition
that all the elements we count must come from the
input list?

  forall x : T,
    x \in s ->
    count (pred1 x) s = count (pred1 x) (sort s)

You may have recognized the proposition
  forall x : T,
    count (pred1 x) s = count (pred1 x) (sort s)

as expressing the notion of _permutation_.
 *)

(**
There is one more concern w.r.t. the spec we came up
with so far -- it's non-computable as it requires us
to compute [count]-expressions over a possibly
infinite type [T].
Intuitively we know that for any two lists we can
compute if one is a permutation of the other if we
have equality over the type of elements.

Mathcomp introduces a computable notion of
equivalence up to permutation: [perm_eq] defined
as follows:
*)

Print perm_eq.
(**
perm_eq =
fun (T : eqType) (s1 s2 : seq T) =>
  all
    [pred x | (count_mem x) s1 == (count_mem x) s2]
    (s1 ++ s2)

is equivalent to

  all
    [pred x | (count_mem x) s1 == (count_mem x) s2]
    s1
  &&
  all
    [pred x | (count_mem x) s1 == (count_mem x) s2]
    s2

: forall T : eqType, seq T -> seq T -> bool

where
Notation count_mem x := (count (pred1 x))
*)

(**
Moreover, any two lists [s1] and [s2] that are
a permutation of each other, give us the following
property which is universal for _any_ predicate [p]:
  forall p : pred T,
    count p s1 = count p s2,
expressed as a [reflect]-predicate:
*)
About permP.
(**
permP :
   forall (T : eqType) (s1 s2 : seq T),
   reflect (count^~ s1 =1 count^~ s2)
           (perm_eq s1 s2)
*)

(**
Alternatively, the notion of permutation may be
expressed as a binary _inductive_ predicate:
 *)
Section InductivePermutations.
Variable A : Type.

Inductive perm : seq A -> seq A -> Prop :=
| permutation_nil : perm [::] [::]
| permutation_skip a v1 v2 of
    perm v1 v2 : perm (a :: v1) (a :: v2)
| permutation_swap a b v1 v2 of
    perm v1 v2 : perm [:: a, b & v1] [:: b, a & v2]
| permutation_trans v1 v2 v3 of
    perm v1 v2 & perm v2 v3 : perm v1 v3.

Inductive le : nat -> nat -> Prop :=
| leO n : le 0 n
| leS m n : le m n -> le m.+1 n.+1.

Definition le_3_4 : le 3 4 :=
  leS (leS (leS (leO _))).

Inductive le' : nat -> nat -> Prop :=
| le_refl n : le' n n
| leSr m n : le' m n -> le' m n.+1.

Definition le_3_4' : le' 3 4 :=
  leSr (le_refl _).

(**
The pros of this definition:
- it can be used to work in a more general setting
  where we don't have decidable equality;
- we can do induction on the proofs of two lists
  being a permutation of each other.

The cons is, of course, it does not compute.
 *)

Lemma pperm_sym v1 v2 :
  perm v1 v2 <-> perm v2 v1.
Proof.
suff {v1 v2} L : forall v1 v2,
  perm v1 v2 -> perm v2 v1 by split; apply: L.
move=> v1 v2; elim=> [*|*|*|].
- exact: permutation_nil.
- exact: permutation_skip.
- exact: permutation_swap.
move=> ??? _ P21 _ P32.
by apply: permutation_trans P32 P21.
(* Restart. *)
(* suff {v1 v2} L : forall v1 v2, *)
(*   perm v1 v2 -> perm v2 v1 by split; apply: L. *)
(* elim. *)
(* Undo 3. *)
Qed.

(** Exercise: try proving [pperm_sym]
    by induction a list.
 *)
End InductivePermutations.

(** * Upshot:
Our final notion of correctness of sorting algorithms
can be expressed semi-formally as follows
  sorted (sort s)  /\  perm_eq s (sort s)
*)

(** Let's try proving these properties for the
    insertion sort algorithm we implemented *)

(** * The output is sorted *)

(* Local Notation sorted := (sorted leT). *)

Lemma sort_sorted s :
  sorted leT (sort s).
Proof.
elim: s=> [//| x s IHs /=].
(** We need the fact that [insert] preserves
    sortedness. Let's prove it as a standalone lemma
 *)
Abort.

Lemma insert_sorted e s :
  sorted leT s ->
  sorted leT (insert e s).
Proof.
elim: s=> [//| x1 s IHs].
move=> /=.
move=> path_x1_s.
case: ifP=> [e_le_x1 | e_gt_x1].
- by rewrite /= e_le_x1 path_x1_s.
(** Notice that we lack one essential fact about
    [leT] -- totality *)
Abort.

Hypothesis leT_total : total leT.
Print total.
(**
total =
fun (T : Type) (R : rel T) =>
  forall x y : T, R x y || R y x
*)

Lemma insert_sorted e s :
  sorted leT s ->
  sorted leT (insert e s).
Proof.
elim: s=> [//| x1 s IHs].
move=> /= path_x1_s.
case: ifP=> [e_le_x1 | e_gt_x1].
- by rewrite /= e_le_x1 path_x1_s.
have:= leT_total e x1.
rewrite {}e_gt_x1.
move=> /= x1_le_e.
move: path_x1_s=> {}/path_sorted/IHs.
case: s=> [|x2 s]; first by rewrite /= x1_le_e.
move=> /=.
case: ifP.
- move=> /=.
  move=>-> /= ->.
  by rewrite x1_le_e.
  (** We are moving in circles here, let's step back
      and generalize the problem. *)
Abort.

Lemma insert_path z e s :
  leT z e ->
  path leT z s ->
  path leT z (insert e s).
Proof.
move: z.
elim: s=> [/=| x1 s IHs] z.
- by move=>->.
move=> z_le_e.
move=> /=.
case/andP=> z_le_x1 path_x1_s.
case: ifP.
- by rewrite /= z_le_e path_x1_s => ->.
move=> /= e_gt_x1.
rewrite z_le_x1.
have:= leT_total e x1.
rewrite {}e_gt_x1 /= => x1_le_e.
exact: IHs.
Qed.

Lemma insert_sorted e s :
  sorted leT s ->
  sorted leT (insert e s).
Proof.
rewrite /sorted.
case: s=> // x s.
move=> /=.
case: ifP; first by move=> /= ->->.
move=> e_gt_x.
apply: insert_path.
have:= leT_total e x.
by rewrite e_gt_x /= => ->.
Qed.

(** exercise *)
Lemma sort_sorted s :
  sorted leT (sort s).
Proof.
Admitted.

End InsertionSort.

Arguments sort {T} _ _.
Arguments insert {T} _ _ _.

Section SortIsPermutation.

Variable T : eqType.
Variables leT : rel T.

(** a helper lemma (exercise) *)
Lemma count_insert p e s :
  count p (insert leT e s) = p e + count p s.
Admitted.

About perm_eql.
(**
Notation perm_eql s1 s2 :=
  (perm_eq s1 =1 perm_eq s2).
 *)

Print perm_eq.
(**
perm_eq =
fun (T : eqType) (s1 s2 : seq T) =>
all [pred x | count_mem x s1 == count_mem x s2]
    (s1 ++ s2)
     : forall T : eqType, seq T -> seq T -> bool
*)

Lemma perm_sort s : perm_eql (sort leT s) s.
Proof.
  (* Search _ perm_eq. *)
  Search _ (perm_eq ?s1 =1 perm_eq ?s2).
apply/permPl/permP.
elim: s=> //= x s IHs.
move=> p.
by rewrite count_insert IHs.
Qed.

(** This is why we state [perm_sort] lemma
    using [perm_eql] -- it can be used as
    an equation like so
 *)
Lemma mem_sort s : sort leT s =i s.
Proof. by apply: perm_mem; rewrite perm_sort. Qed.

Lemma sort_uniq s : uniq (sort leT s) = uniq s.
Proof. by apply: perm_uniq; rewrite perm_sort. Qed.

End SortIsPermutation.

Section SortProperties.

Variable T : eqType.
Variables leT : rel T.

Lemma sorted_sort s :
  sorted leT s -> sort leT s = s.
Proof.
elim: s=> // x1 s IHs S.
move: (S)=> {}/sorted_cons/IHs /= ->.
move: S=> /=.
case: s=> //= x2 s.
by case/andP=> ->.
Qed.

(** Insertion sort is stable (exercise) *)
Section Stability.

Variable leT' : rel T.
Implicit Types s : seq T.

(** Hint: you are free to assume e.g.
          [transitivity] of [leT] / [leT'] should
          you need that. E.g.
Hypothesis leT_tr : transitive leT.
 *)

Lemma sort_stable s :
  sorted leT' s ->
  sorted
    [rel x y | leT x y && (leT y x ==> leT' x y)]
    (sort leT s).
Proof.
Admitted.
End Stability.

End SortProperties.

End Insertion.


Require Import list.
Require Import nat.
Require Import bool.

Theorem silly1 : forall (n m o p:nat),
    n = m -> [n,o] = [n,p] -> [n,o] = [m,p].
Proof.
    intros n m o p H1 H2. rewrite <- H1. exact H2.
Qed.

Theorem silly2 : forall (n m o p:nat),
    n = m -> (forall (q r:nat), q = r -> [q,o] = [r,p]) -> [n,o] = [m,p].
Proof.
    intros n m o p H1 H2. apply H2. exact H1.
Qed.

Theorem silly_ex : (forall n:nat, evenb n = true -> oddb (S n) = true) ->
    evenb 3 = true -> oddb 4 = true.
Proof. intros H1 H2. apply H1. exact H2. Qed.

Theorem silly3 : forall n:nat,
    true = eqb n 5 -> eqb (S (S n)) 7 = true.
Proof.
    intros n H. simpl. symmetry. exact H.
Qed.

(*
SearchAbout rev.
*)

Theorem rev_ex1 : forall (a:Type) (l k:list a),
    l = rev k -> k = rev l.
Proof.
    intros a l k H. assert (rev l = rev (rev k)) as H'. { rewrite H. reflexivity. }
    rewrite rev_involutive in H'. symmetry. exact H'.
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 H1 H2. rewrite H1, H2. reflexivity.
Qed.

Theorem trans_eq : forall (a:Type) (x y z:a),
    x = y -> y = z -> x = z.
Proof.
    intros a x y z H1 H2. rewrite H1, H2. 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. apply trans_eq. Qed.

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

Example trans_eq_ex : forall (n m p q:nat),
    m = (minustwo p) ->
    (n + q) = m ->
    (n + q) = (minustwo p).
Proof.
    intros n m p q H1 H2. apply trans_eq with (y:= m).
    exact H2. exact H1.
Qed.


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

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

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

Definition nandb b1 b2 :=
  match b1 with
  | true => negb b2
  | 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 b2 b3 :=
  match b1 with
  | true => andb b2 b3
  | false => false
  end.

Check true.
Check andb.
Check andb3.

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

Eval simpl in minustwo 4.

Check S.
Check O.
Check pred.

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

Definition oddb n := 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.

Check plus.
Check mult.
Check minus.

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

Example test_exp1: exp 2 3 = 8.
Proof. reflexivity. Qed.

Fixpoint factorial n :=
  match n with
  | O => S O
  | S n' => mult 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" := (mult x y) (at level 40, left associativity) : nat_scope.
Notation "x - y" := (minus x y) (at level 50, left associativity): nat_scope.

Eval simpl in 0 - 1 + 2.

Fixpoint beq_nat n m :=
  match n, m with
  | O, O => true
  | O, _ | _, O => false
  | S n', S m' => beq_nat n' m'
  end.

Fixpoint ble_nat n m :=
  match n, m with
  | O, _ => true
  | _, O => false
  | S n', S m' => ble_nat n' m'
  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.

Theorem plus_O_n: forall n, 0 + n = n.
Proof.
  intro n.
  reflexivity.
Qed.

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

Theorem mult_0_l: forall n, 0 * n = 0.
Proof.
  intro n.
  simpl.
  reflexivity.
Qed.

Theorem plus_id_example:
  forall n m, n = m -> n + n = m + m.
Proof.
  intros n m.
  intro H.
  rewrite -> H.
  reflexivity.
Qed.

Theorem plus_id_exercise:
  forall n m o, n = m -> m = o -> n + m = m + o.
Proof.
  intros n m o.
  intro h1.
  intro h2.
  rewrite -> h1.
  rewrite -> h2.
  reflexivity.
Qed.

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

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

Theorem plus_1_neq_0_firsttry:
  forall n, beq_nat (n + 1) 0 = false.
Proof.
  intro n.
  simpl.
Abort.

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

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

Theorem zero_nbeq_plus_1:
  forall n, beq_nat 0 (n + 1) = false.
Proof.
  intro n.
  destruct n.
  reflexivity.
  reflexivity.
Qed.

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

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

Theorem orb_true_eq_true:
  forall b, orb b true = true.
Proof.
  intro b.
  destruct b.
  reflexivity.
  reflexivity.
Qed.

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

Theorem and_f_t_f: andb false true = false.
Proof. reflexivity. Qed.

  rewrite <- and_f_t_f.
  rewrite -> H.
  reflexivity.
  destruct b.

Theorem and_t_f_f: andb true false = false.
Proof. reflexivity. Qed.

  rewrite <- and_t_f_f.
  rewrite -> H.
  reflexivity.
  reflexivity.
Qed.

Inductive bin :=
  | Z
  | T: bin -> bin
  | TPlus: bin -> bin.

Fixpoint incr n :=
  match n with
  | Z => TPlus Z
  | T n' => TPlus n'
  | TPlus n' => T (incr n')
  end.

Fixpoint toNat n :=
  match n with
  | Z => O
  | T n' => mult 2 (toNat n')
  | TPlus n' => S (mult 2 (toNat n'))
  end.

Eval simpl in toNat (TPlus (T (TPlus Z))).

Example nine_toNat_plus_eq: S (toNat (TPlus (T (T (TPlus Z))))) = toNat (incr (TPlus (T (T (TPlus Z))))).
Proof. reflexivity. Qed.

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


Require Export Coq.Lists.List
        Coq.Sorting.Permutation
        CoqRecon.Util.Base Coq.micromega.Lia
        Coq.Arith.Compare_dec.
Export ListNotations.

Section Uniques.
  Context {A : Set}.
  Context {HEA: EqDec A eq}.

  Fixpoint remove (a : A) (l : list A) : list A :=
    match l with
    | []    => []
    | h :: l => (if h == a then [] else [h]) ++ remove a l
    end.

  Lemma remove_correct : forall l a, ~ In a (remove a l).
  Proof.
    intro l; induction l as [| h l IHl];
      intros a H; simpl in *; auto.
    dispatch_eqdec; firstorder.
  Qed.

  Lemma remove_not_in : forall l a,
      ~ In a l -> remove a l = l.
  Proof.
    intro l; induction l as [| h l IHl];
      intros a H; simpl in *; auto.
    apply Decidable.not_or in H as (Hha & Hal).
    dispatch_eqdec.
    apply IHl in Hal. rewrite Hal. reflexivity.
  Qed.

  Lemma remove_sound : forall l a x,
      In a (remove x l) -> In a l.
  Proof.
    intro l; induction l as [| h l IHl];
      intros a x Hal; simpl in *; auto.
    dispatch_eqdec; firstorder.
  Qed.

  Lemma remove_complete : forall l a x,
      x <> a -> In a l -> In a (remove x l).
  Proof.
    intro l; induction l as [| h l IHl];
      intros a x Hax Hal; simpl in *; auto.
    dispatch_eqdec; destruct Hal; intuition.
  Qed.

  Fixpoint uniques (l : list A) : list A :=
    match l with
    | []    => []
    | a :: l => a :: remove a (uniques l)
    end.

  Lemma uniques_sound : forall l a,
      In a (uniques l) -> In a l.
  Proof.
    intro l; induction l as [| h l IHl];
      intros a Hal; simpl in *; auto.
    destruct Hal as [Hha | Hal]; eauto using remove_sound.
  Qed.

  Lemma uniques_complete : forall l a,
      In a l -> In a (uniques l).
  Proof.
    intro l; induction l as [| h l IHl];
      intros a Hal; simpl in *; auto.
    eqdec h a; auto.
    destruct Hal; try contradiction.
    eauto using remove_complete.
  Qed.

  Local Hint Constructors NoDup : core.
  Local Hint Resolve remove_sound : core.

  Lemma remove_nodup : forall l,
      NoDup l -> forall a, NoDup (remove a l).
  Proof.
    intros l H; induction H; intros a; simpl; auto.
    dispatch_eqdec; eauto.
  Qed.

  Local Hint Resolve remove_correct : core.
  Local Hint Resolve remove_nodup : core.

  Lemma uniques_nodup : forall l,
      NoDup (uniques l).
  Proof.
    intro l; induction l as [| a l IHl]; simpl; auto.
  Qed.

  Local Hint Resolve remove_not_in : core.

  Lemma NoDup_uniques_idem : forall l,
      NoDup l -> uniques l = l.
  Proof.
    intros l Hnd;
      induction Hnd as [| a l Hal Hl IHl];
      simpl; f_equal; rewrite IHl; auto.
  Qed.

  Local Hint Resolve uniques_sound : core.
  Local Hint Resolve uniques_complete : core.

  Lemma uniques_iff : forall a l,
      In a (uniques l) <-> In a l.
  Proof.
    intuition.
  Qed.

  Lemma remove_length : forall l a,
      length (remove a l) <= length l.
  Proof.
    intro l; induction l as [| h l IHl];
      intro a; simpl; auto.
    rewrite app_length.
    specialize IHl with a. dispatch_eqdec; lia.
  Qed.

  Lemma uniques_length : forall l,
      length (uniques l) <= length l.
  Proof.
    intro l; induction l as [| a l IHl]; simpl in *; auto.
    pose proof remove_length (uniques l) a. lia.
  Qed.

  Lemma remove_idempotent : forall l a,
      remove a (remove a l) = remove a l.
  Proof.
    intros l a.
    rewrite remove_not_in with (l := remove a l) by auto.
    reflexivity.
  Qed.

  Lemma remove_comm : forall l a x,
      remove a (remove x l) = remove x (remove a l).
  Proof.
    intro l; induction l as [| h l IHl];
      intros a x; simpl; auto; repeat dispatch_eqdec;
        auto; rewrite IHl; reflexivity.
  Qed.

  Lemma remove_uniques_comm : forall l a,
      remove a (uniques l) = uniques (remove a l).
  Proof.
    intro l; induction l as [| h l IHl];
      intro a; simpl; try dispatch_eqdec; auto.
    - rewrite remove_idempotent; auto.
    - rewrite remove_comm. rewrite IHl.
      reflexivity.
  Qed.

  Lemma uniques_idempotent : forall l,
      uniques (uniques l) = uniques l.
  Proof.
    intro l; induction l as [| a l IHl]; simpl; auto.
    repeat rewrite <- remove_uniques_comm.
    rewrite remove_idempotent. rewrite IHl.
    reflexivity.
  Qed.

  Lemma remove_app : forall l r a,
      remove a (l ++ r) = remove a l ++ remove a r.
  Proof.
    intro l; induction l as [| h l IHl];
      intros r a; simpl; try dispatch_eqdec;
        try rewrite IHl; auto.
  Qed.

  Lemma uniques_app : forall l r,
      uniques (l ++ r) = uniques (uniques l ++ uniques r).
  Proof.
    intro l; induction l as [| h l IHl];
      intro r; simpl.
    - rewrite uniques_idempotent. reflexivity.
    - f_equal. rewrite IHl.
      repeat rewrite remove_uniques_comm.
      repeat rewrite remove_app.
      rewrite <- remove_uniques_comm.
      rewrite remove_idempotent. reflexivity.
  Qed.

  Lemma remove_rev : forall l a,
      rev (remove a l) = remove a (rev l).
  Proof.
    intro l; induction l as [| h l IHl];
      intro a; simpl; auto.
    repeat rewrite remove_app; simpl.
    rewrite rev_app_distr.
    rewrite IHl. f_equal.
    dispatch_eqdec; reflexivity.
  Qed.

  Lemma uniques_app2 : forall l r,
      uniques (l ++ r) = uniques l ++ fold_right remove (uniques r) l.
  Proof.
    intro l; induction l as [| h l IHl];
      intro r; simpl; auto.
    f_equal. rewrite IHl.
    rewrite remove_app. reflexivity.
  Qed.

  Lemma uniques_repeat : forall n a,
      uniques (repeat a n) =
      match n with
      | O   => []
      | S _ => [a]
      end.
  Proof.
    intro n; induction n as [| n IHn];
      intro a; simpl; auto.
    rewrite IHn.
    destruct n; simpl; try dispatch_eqdec; auto.
  Qed.

  Fixpoint count (a : A) (l : list A) : nat :=
    match l with
    | []    => 0
    | h :: l => (if h == a then 1 else 0) + count a l
    end.

  Lemma count_app : forall l r a,
      count a (l ++ r) = count a l + count a r.
  Proof.
    intro l; induction l as [| h l IHl]; intros r a; simpl; auto.
    rewrite IHl. rewrite PeanoNat.Nat.add_assoc. reflexivity.
  Qed.

  Lemma count_remove : forall l a, count a (remove a l) = 0.
  Proof.
    intro l; induction l as [| h l IHl]; intro a; simpl;
      repeat dispatch_eqdec; try rewrite IHl; auto.
  Qed.

  Lemma count_remove_le : forall l a x,
      count a (remove x l) <= count a l.
  Proof.
    intro l; induction l as [| h l IHl]; intros a x; simpl; try lia.
    specialize IHl with (a := a) (x := x).
    repeat dispatch_eqdec; try lia.
  Qed.

  Lemma count_uniques : forall l a,
      count a (uniques l) <= 1.
  Proof.
    intro l; induction l as [| h l IHl]; intro a; simpl; auto.
    specialize IHl with a. dispatch_eqdec.
    - rewrite count_remove. lia.
    - pose proof count_remove_le (uniques l) a h as Hle. lia.
  Qed.

  Lemma count_in : forall l a,
      In a l <-> count a l > 0.
  Proof.
    intro l; induction l as [| h l IHl];
      intro a; simpl; split; intros H;
        try dispatch_eqdec; try firstorder lia.
  Qed.

  Corollary count_uniques_in : forall a l,
      In a l -> count a (uniques l) = 1.
  Proof.
    intros a l Hal.
    rewrite <- uniques_iff in Hal.
    rewrite count_in in Hal.
    pose proof count_uniques l a. lia.
  Qed.

  Lemma count_not_in : forall l a,
      ~ In a l <-> count a l = 0.
  Proof.
    intro l; induction l as [| h l IHl];
      intro a; simpl; split; intros H;
        try dispatch_eqdec; try firstorder lia.
  Qed.

  Lemma count_length_le : forall l a,
      count a l <= length l.
  Proof.
    intro l; induction l as [| h l IHl];
      intro a; simpl; try lia.
    specialize IHl with a.
    dispatch_eqdec; lia.
  Qed.

  Lemma count_remove_length : forall l a,
      length (remove a l) = length l - count a l.
  Proof.
    intro l; induction l as [| h l IHl]; intro a; simpl;
      repeat dispatch_eqdec; auto.
    destruct (count a l) as [| n] eqn:Hcnt.
    - rewrite <- count_not_in in Hcnt.
      rewrite remove_not_in by assumption. reflexivity.
    - rewrite IHl. rewrite Hcnt.
      pose proof count_length_le l a as HCL. lia.
  Qed.

  Lemma count_repeat : forall n a,
      count a (repeat a n) = n.
  Proof.
    intro n; induction n as [| n IHn]; intro a; simpl;
      try dispatch_eqdec; try rewrite IHn; auto.
  Qed.

  Local Hint Constructors Permutation : core.

  Lemma remove_perm : forall l l',
      Permutation l l' -> forall a, Permutation (remove a l) (remove a l').
  Proof.
    intros l l' H; induction H; intro a; simpl;
      repeat dispatch_eqdec; eauto.
  Qed.

  Local Hint Resolve remove_perm : core.

  Lemma uniques_perm : forall l l',
      Permutation l l' -> Permutation (uniques l) (uniques l').
  Proof.
    intros l l' H; induction H; simpl; eauto 3.
    rewrite remove_comm. repeat dispatch_eqdec; auto.
  Qed.

  Lemma In_split_repeat_perm : forall l (a : A),
      In a l -> exists n l',
        ~ In a l' /\ Permutation l (repeat a (S n) ++ l').
  Proof.
    intro l; induction l as [| h t IHt];
      intros a Hal; simpl in *; try contradiction.
    destruct (In_dec HEA a t) as [Hat | Hat]; eqdec h a;
      destruct Hal as [Hha' | Hat']; subst; simpl;
        try contradiction.
    - apply IHt in Hat as (n & l' & Hl' & HP).
      exists (S n). exists l'. simpl; intuition.
    - apply IHt in Hat as (n & l' & Hl' & HP).
      exists (S n). exists l'. simpl; intuition.
    - apply IHt in Hat as (n & l' & Hl' & HP).
      exists n. exists (h :: l'). simpl; intuition.
      rewrite app_comm_cons in *.
      auto using Permutation_cons_app.
    - exists 0. exists t. simpl; intuition.
  Qed.

  Lemma length_uniques_app_le : forall l r,
      length (uniques l) <= length (uniques (l ++ r)).
  Proof.
    intros l r.
    rewrite uniques_app2.
    rewrite app_length. lia.
  Qed.

  Lemma uniques_Forall : forall P l,
      Forall P (uniques l) <-> Forall P l.
  Proof.
    intros P l; repeat rewrite Forall_forall; intuition.
  Qed.

  Lemma uniques_nil : forall l,
      uniques l = [] <-> l = [].
  Proof.
    intro l; split; intros H; simpl in *; subst; auto.
    destruct l; simpl in *; auto; try discriminate.
  Qed.
End Uniques.

Section Inside.
  Context {A : Set}.

  Inductive inside (a : A) : list A -> Prop :=
  | inside_cons_hd t :
      inside a (a :: t)
  | inside_cons_tl h t :
      h <> a ->
      inside a t ->
      inside a (h :: t).

  Lemma inside_sound : forall a l, inside a l -> In a l.
  Proof.
    intros a l H; induction H; intuition.
  Qed.

  Lemma inside_split_first : forall a l,
      inside a l -> exists l1 l2, l = l1 ++ a :: l2 /\ ~ inside a l1.
  Proof.
    intros a l H; induction H.
    - exists [], t. split; auto.
      intros H; inv H.
    - destruct IHinside as (l1 & l2 & Ht & Hl1); subst.
      exists (h :: l1), l2. split; auto.
      intros Hin; inv Hin; contradiction.
  Qed.

  Hypothesis Hexm_eq : forall a1 a2 : A, a1 = a2 \/ a1 <> a2.

  Local Hint Constructors inside : core.

  Lemma inside_complete : forall l a, In a l -> inside a l.
  Proof.
    intro l; induction l as [| h t IHt];
      intros a Hal; simpl in *; try contradiction.
    destruct (Hexm_eq h a) as [Hha | Hha];
      firstorder subst; auto.
  Qed.

  Local Hint Resolve inside_sound : core.
  Local Hint Resolve inside_complete : core.

  Lemma inside_in_iff : forall a l,
      inside a l <-> In a l.
  Proof.
    intuition.
  Qed.

  Lemma inside_in_not_iff : forall a l,
      ~ inside a l <-> ~ In a l.
  Proof.
    intuition.
  Qed.

  Lemma in_split_first : forall (a : A) l,
      In a l -> exists l1 l2, l = l1 ++ a :: l2 /\ ~ In a l1.
  Proof.
    intros a l HIn.
    apply inside_complete in HIn.
    apply inside_split_first in HIn
      as (l1 & l2 & Hl & Hl1); subst.
    exists l1, l2; auto.
  Qed.
End Inside.

Fixpoint flipper {A B : Set} (C : list (A * B)) : list (B * A) :=
  match C with
  | []         => []
  | (l, r) :: C => (r, l) :: flipper C
  end.

Lemma flipper_involutive : forall (A B : Set) (C : list (A * B)),
    flipper (flipper C) = C.
Proof.
  intros A B C; induction C as [| [l r] C IHC]; simpl; f_equal; auto.
Qed.

Lemma flipper_nil : forall (A B : Set) (C : list (A * B)),
    flipper C = [] -> C = [].
Proof.
  intros A B C HC.
  destruct C as [| [? ?] ?];
    simpl in *; try discriminate; reflexivity.
Qed.

Lemma in_flipper : forall (A B : Set) l (a : A) (b : B),
    In (a, b) l -> In (b, a) (flipper l).
Proof.
  intros A B l; induction l as [| [u v] l IHl];
    intros a b Hin; simpl in *; auto.
  destruct Hin as [Hab | Hab]; try inv Hab; auto.
Qed.

Section PairLists.
  Context {U V : Set}.

  Lemma combine_map_fst : forall (us : list U) (vs : list V),
      map fst (combine us vs) = firstn (min (length us) (length vs)) us.
  Proof.
    intro us; induction us as [| u us IHus];
      intros [| v vs]; simpl; f_equal; auto.
  Qed.

  Lemma combine_map_snd : forall (vs : list V) (us : list U),
      map snd (combine us vs) = firstn (min (length us) (length vs)) vs.
  Proof.
    intro vs; induction vs as [| v vs IHvs];
    intros [| u us]; simpl; f_equal; auto.
  Qed.

  Lemma split_map : forall (l : list (U * V)),
      split l = (map fst l, map snd l).
  Proof.
    intro l; induction l as [| [u v] t IHt]; simpl; auto.
    destruct (split t) as [us vs] eqn:Hsplit; simpl; inv IHt; auto.
  Qed.

  Lemma combine_map : forall (l : list (U * V)),
      combine (map fst l) (map snd l) = l.
  Proof.
    intros l.
    pose proof split_combine l as H.
    destruct (split l) as [us vs] eqn:Hsplit.
    rewrite split_map in Hsplit.
    injection Hsplit as Hus Hvs.
    rewrite Hus, Hvs; assumption.
  Qed.

  Hint Rewrite map_length : core.
  Local Hint Resolve combine_map : core.

  Lemma combine_ex : forall (l : list (U * V)),
      exists us vs, l = combine us vs /\ length us = length vs.
  Proof.
    intro l. exists (map fst l). exists (map snd l).
    autorewrite with core; auto.
  Qed.

  Lemma flipper_combine : forall (us : list U) (vs : list V),
      flipper (combine us vs) = combine vs us.
  Proof.
    intro us; induction us as [| u us IHus];
      intros [| v vs]; simpl; f_equal; auto.
  Qed.

  Local Hint Constructors NoDup : core.

  Lemma NoDup_combine : forall (us : list U),
      NoDup us ->
      forall (vs : list V),
        NoDup (combine us vs).
  Proof.
    intros us Hndu; induction Hndu;
      intros [| v vs]; simpl; auto.
    assert (~ In (x, v) (combine l vs)).
    { intros Hin.
      apply in_combine_l in Hin as ?; contradiction. }
    auto.
  Qed.

  Lemma NoDup_pair_eq_r : forall us,
      NoDup us ->
      forall vs (u : U) (v1 v2 : V),
        In (u,v1) (combine us vs) ->
        In (u,v2) (combine us vs) ->
        v1 = v2.
  Proof.
    intros us Hnd; induction Hnd;
      intros [| v vs] u v1 v2 Hv1 Hv2;
      simpl in *; try contradiction.
    destruct Hv1 as [Hv1 | Hv1];
      destruct Hv2 as [Hv2 | Hv2]; subst;
        try inv Hv1; try inv Hv2; eauto;
          try apply in_combine_l in Hv2;
          try apply in_combine_l in Hv1; contradiction.
  Qed.

  Lemma NoDup_pair_eq_l : forall vs,
      NoDup vs ->
      forall us (u1 u2 : U) (v : V),
        In (u1,v) (combine us vs) ->
        In (u2,v) (combine us vs) ->
        u1 = u2.
  Proof.
    intros vs Hnd; induction Hnd;
      intros [| u us] u1 u2 v Hin1 Hin2;
      simpl in *; try contradiction.
    destruct Hin1 as [Hu1 | Hin1];
      destruct Hin2 as [Hu2 | Hin2];
      try inv Hu1; try inv Hu2; eauto;
        try apply in_combine_r in Hin2;
        try apply in_combine_r in Hin1; contradiction.
  Qed.

  Lemma in_combine_nth_error : forall us vs (u : U) (v : V),
      In (u,v) (combine us vs) ->
      exists n, nth_error us n = Some u /\ nth_error vs n = Some v.
  Proof.
    intro us; induction us as [| hu us IHus];
      intros [| hv vs] u v Hin; simpl in *;
        try contradiction.
    destruct Hin as [Hin | Hin]; try inv Hin.
    - exists 0; auto.
    - apply IHus in Hin as (n & Hus & Hvs).
      exists (S n); auto.
  Qed.

  Lemma nth_error_combine_some : forall n us vs (u : U) (v : V),
      nth_error us n = Some u ->
      nth_error vs n = Some v ->
      nth_error (combine us vs) n = Some (u, v).
  Proof.
    intro n; induction n as [| n IHn];
      intros [| hu us] [| hv vs] u v Hu Hv;
      simpl in *; inv Hu; inv Hv; auto.
  Qed.

  Local Hint Resolve nth_error_combine_some : core.

  Lemma in_combine_index : forall n us vs (u : U) (v : V),
      nth_error us n = Some u ->
      nth_error vs n = Some v ->
      In (u,v) (combine us vs).
  Proof.
    intros n us vs u v Hu Hv.
    eauto using nth_error_In.
  Qed.

  Context {HEU : EqDec U eq} {HEV : EqDec V eq}.

  Lemma not_in_combine : forall us vs (u : U) (v : V),
      ~ In (u,v) (combine us vs) ->
      ~ In u us /\ ~ In v vs \/
      In u us   /\ ~ In v vs \/
      ~ In u us /\   In v vs \/
      exists m n, m <> n /\ nth_error us m = Some u /\ nth_error vs n = Some v.
  Proof.
    intros us vs u v Hin.
    pose proof in_dec HEU u us as [Huus | Huus];
      pose proof in_dec HEV v vs as [Hvvs | Hvvs]; auto.
    apply In_nth_error in Huus, Hvvs.
    destruct Huus as [p Hus]; destruct Hvvs as [q Hvs].
    repeat right. exists p, q; intuition; subst.
    apply Hin. apply nth_error_In with q; auto.
  Qed.
End PairLists.

Lemma nodup_triple_eq_r : forall {U V W : Set} us,
    NoDup us ->
    forall (u : U) (v : V) (w1 w2 : W) vs ws,
      NoDup vs ->
      In (u,v) (combine us vs) ->
      In (u,w1) (combine us ws) ->
      In (v,w2) (combine vs ws) -> w1 = w2.
Proof.
  intros U V W us Hndus;
    induction Hndus as [| hu us Hninu Hndus IHus];
    intros u v w1 w2 vs [| w ws] Hndvs Huv Huw Hvw;
    inversion Hndvs as [Hvsnil | hv tvs Hninhv Hndtvs]; subst;
      simpl in *; try contradiction.
  destruct Huv as [Huv | Huv];
    destruct Huw as [Huw | Huw];
    destruct Hvw as [Hvw | Hvw];
    try inv Huv; try inv Huw; try inv Hvw; eauto;
      try apply in_combine_l in Hvw;
      try apply in_combine_l in Huw;
      try apply in_combine_l in Huv as Hu';
      try apply in_combine_r in Huv as Hv';
      contradiction.
Qed.

Lemma flipper_combine_map_fst : forall {U V : Set} (us : list U) (vs : list V),
    map fst (flipper (combine us vs)) =
    firstn (min (length us) (length vs)) vs.
Proof.
  intros U V us vs.
  rewrite flipper_combine.
  rewrite combine_map_fst.
  f_equal. lia.
Qed.

Lemma flipper_combine_map_snd : forall {U V : Set} (us : list U) (vs : list V),
    map snd (flipper (combine us vs)) =
    firstn (min (length us) (length vs)) us.
Proof.
  intros U V us vs.
  rewrite flipper_combine.
  rewrite combine_map_snd.
  f_equal; lia.
Qed.

Lemma combine_map_l :
  forall {U V W : Set} (f : U -> W) (us : list U) (vs : list V),
    combine (map f us) vs = map (fun '(u,v) => (f u,v)) (combine us vs).
Proof.
  intros U V W f us; induction us as [| u us IHus];
    intros [| v vs]; simpl; f_equal; auto.
Qed.

Lemma combine_map_r :
  forall {U V W : Set} (f : V -> W) (us : list U) (vs : list V),
    combine us (map f vs) = map (fun '(u,v) => (u,f v)) (combine us vs).
Proof.
  intros U V W f us; induction us as [| u us IHus];
    intros [| v vs]; simpl; f_equal; auto.
Qed.

Lemma in_combine_flip :
  forall {U V : Set} us vs (u : U) (v : V),
    In (u,v) (combine us vs) -> In (v,u) (combine vs us).
Proof.
  intros U V us; induction us as [| hu us IHus];
    intros [| hv vs] u v Hin; simpl in *;
      try contradiction.
  destruct Hin as [Huv | Hin]; try inv Huv; auto.
Qed.

Lemma nodup_nth_error : forall (A : Set) l,
    NoDup l ->
    forall m n (a : A),
      nth_error l m = Some a ->
      nth_error l n = Some a -> m = n.
Proof.
  intros A l Hnd; induction Hnd;
    intros [| m] [| n] h Hm Hn; simpl in *;
      try discriminate; auto.
  - inv Hm; apply nth_error_In in Hn; contradiction.
  - inv Hn; apply nth_error_In in Hm; contradiction.
  - f_equal; eauto.
Qed.

(** My contribution to the standard library. *)
Section CuttingMap.
  Context {A B : Set}.
  Variable (f : A -> B).

  Lemma firstn_map : forall n l,
      firstn n (map f l) = map f (firstn n l).
  Proof.
    intro n; induction n as [| n IHn];
      intros [| a l]; simpl in *; f_equal; auto.
  Qed.

  Lemma skipn_map : forall n l,
      skipn n (map f l) = map f (skipn n l).
  Proof.
    intro n; induction n as [| n IHn];
      intros [| a l]; simpl in *; f_equal; auto.
  Qed.
End CuttingMap.

Section FilterMap.
  Context {A B : Set}.

  Section FM.
    Variable (f : A -> option B).

    Fixpoint filtermap (l : list A) : list B :=
      match l with
      | []    => []
      | a :: l => match f a with
                | Some b => [b]
                | None   => []
                end ++ filtermap l
      end.

    Lemma filtermap_app : forall l1 l2,
        filtermap (l1 ++ l2) = filtermap l1 ++ filtermap l2.
    Proof.
      intro l1; induction l1 as [| a l1 IHl1]; intro l2; simpl; auto.
      rewrite <- app_assoc, <- IHl1; f_equal.
    Qed.

    Lemma filtermap_fold_right : forall l,
        filtermap l =
        fold_right
          (fun a acc =>
             match f a with
             | Some b => [b]
             | None   => []
             end ++ acc) [] l.
    Proof.
      intro l; induction l as [| a l IHl]; simpl; auto.
    Qed.

    Lemma in_filtermap : forall l a b,
        f a = Some b -> In a l -> In b (filtermap l).
    Proof.
      intro l; induction l as [| h l IHl];
        intros a b Hfab Hin; simpl in *;
          try contradiction.
      rewrite in_app_iff.
      destruct Hin as [? | Hin]; subst;
        try rewrite Hfab; simpl; firstorder.
    Qed.

    Fixpoint separate (l : list A) : list A * list B :=
      match l with
      | []    => ([], [])
      | a :: l =>
        let (la,lb) := separate l in
        match f a with
        | Some b => (la, b :: lb)
        | None   => (a :: la, lb)
        end
      end.

    Lemma separate_filtermap : forall l,
        snd (separate l) = filtermap l.
    Proof.
      intro l; induction l as [| a l IHl]; simpl; auto.
      destruct (separate l) as [us vs] eqn:Huvs;
        destruct (f a) as [b |] eqn:Hfabeq;
        simpl in *; f_equal; auto.
    Qed.

    Lemma in_snd_separate : forall l a b,
        f a = Some b -> In a l -> In b (snd (separate l)).
    Proof.
      intros l a b.
      rewrite separate_filtermap.
      eauto using in_filtermap.
    Qed.

    Lemma in_fst_separate : forall l a,
        f a = None -> In a l -> In a (fst (separate l)).
    Proof.
      intro l; induction l as [| h l IHl];
        intros a Hfa Hin; simpl in *; try contradiction.
      specialize IHl with a.
      destruct (separate l) as [la lb] eqn:Hsep.
      destruct (f h) as [b |] eqn:Hfh;
        destruct Hin as [? | Hin]; subst; simpl in *; intuition.
      rewrite Hfa in Hfh; discriminate.
    Qed.

    Lemma in_fst_separate_in_orig : forall l a,
        In a (fst (separate l)) -> In a l.
    Proof.
      intro l; induction l as [| h l IHl];
        intros a Hin; simpl in *; auto.
      destruct (separate l) as [la lb] eqn:Hsep; simpl in *.
      destruct (f h) as [b |] eqn:Hfhb; simpl in *;
        intuition.
    Qed.

    Lemma not_in_fst_separate : forall l a b,
        f a = Some b -> In a l -> ~ In a (fst (separate l)).
    Proof.
      intro l; induction l as [| h l IHl];
        intros a b Hfab Hal Hafsl; simpl in *; auto.
      destruct (separate l) as [la lb] eqn:Hsep.
      destruct (f h) as [bh |] eqn:Hfhb; simpl in *;
        destruct Hal as [? | Hal]; subst.
      - rewrite Hfab in Hfhb; inv Hfhb.
        assert (Hal: In a l).
        { replace la with (fst (separate l)) in Hafsl.
          - auto using in_fst_separate_in_orig.
          - rewrite Hsep; reflexivity. }
        firstorder.
      - firstorder.
      - rewrite Hfab in Hfhb; discriminate.
      - destruct Hafsl as [? | Hala]; subst; firstorder.
        rewrite Hfab in Hfhb; discriminate.
    Qed.

    Lemma separate_app : forall l1 l2,
        separate (l1 ++ l2) =
        let (us1, bs1) := separate l1 in
        let (us2, bs2) := separate l2 in
        (us1 ++ us2, bs1 ++ bs2).
    Proof.
      intro l1; induction l1 as [| a l1 IHl1]; intro l2; simpl.
      - destruct (separate l2); auto.
      - specialize IHl1 with l2;
          destruct (separate (l1 ++ l2)) as [us bs] eqn:Heql;
          destruct (separate l1) as [us1 bs1] eqn:Heql1;
          destruct (separate l2) as [us2 bs2] eqn:Heql2;
          inv IHl1; destruct (f a) as [b |] eqn:Heqfab;
            simpl in *; repeat f_equal.
    Qed.
  End FM.
End FilterMap.


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

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

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

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

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

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

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

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

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

Fixpoint nonZeros(n:natlist) : natlist :=
match n with
| [] => []
| x :: xs => match x with
    | 0 => nonZeros(xs)
    | _ => x :: nonZeros(xs)
    end
end.

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

Lemma nonZerosLemma : forall l1 l2 : natlist, nonZeros (l1 ++ l2 ) = (nonZeros l1 ) ++ (nonZeros l2 ).
Proof.
intros l1 l2.
induction l1.
simpl. reflexivity.
simpl.
destruct n.
simpl. rewrite IHl1.
reflexivity.
simpl. rewrite IHl1.
reflexivity.
Qed.

Eval compute in( nonZeros [0;1;2;0;0;4;5;0]).
Eval compute in( nonZerosLemma [0;1;2;0;0;4;5;0] [0;1;2;0]).


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

Require Import List.
Require Import Permutation.
Require Import Arith.

Require Omega.

Require Import list_aux.
Require Import list_perm.

Set Implicit Arguments.

(* list product *)

Section list_prod.

  Variables (A B C : Type) (f : A -> B -> C).

  (* list_prod [a1;...;an] [b1;...;bm] = [f a1 b1; f a2 b1;...;f an b1;f a1 b2;...;f an b2;...;f a1 bm;...;f an bm] *)

  Definition list_prod ll mm := flat_map (fun y => map (fun x => f x y) ll) mm.

  Fact list_prod_spec ll mm : forall c, In c (list_prod ll mm) <-> exists a b, In a ll /\ In b mm /\ c = f a b.
  Proof.
    intros c; split; unfold list_prod;
    rewrite in_flat_map.
    intros (b & H1 & H2).
    rewrite in_map_iff in H2.
    destruct H2 as (a & H2 & H3).
    exists a, b; auto.
    intros (a & b & H1 & H2 & H3).
    exists b; split; auto.
    rewrite in_map_iff.
    exists a; auto.
  Qed.

  Fact list_prod_length ll mm : length (list_prod ll mm) = length ll * length mm.
  Proof.
    rewrite mult_comm; induction mm; simpl; auto.
    rewrite app_length, map_length; f_equal; auto.
  Qed.

  Fact list_prod_nil ll mm : list_prod ll mm = nil -> ll = nil \/ mm = nil.
  Proof.
    intros H.
    apply f_equal with (f := @length _) in H.
    rewrite list_prod_length in H; simpl in H.
    destruct ll; auto.
    destruct mm; auto.
    simpl in H; discriminate H.
  Qed.

  Fact list_prod_nil_left mm : list_prod nil mm = nil.
  Proof.
    induction mm; simpl; f_equal; auto.
  Qed.

  Fact list_prod_nil_right ll : list_prod ll nil = nil.
  Proof.
    reflexivity.
  Qed.

  Fact list_prod_sg_right ll x : list_prod ll (x::nil) = map (fun a => f a x) ll.
  Proof.
    symmetry; apply app_nil_end.
  Qed.

  Fact list_prod_app_left ll mm nn : list_prod (ll++mm) nn ~p list_prod ll nn ++ list_prod mm nn.
  Proof.
    induction nn as [ | x nn IH ]; simpl.
    apply perm_nil.
    rewrite map_app, app_ass, app_ass.
    apply Permutation_app; auto.
    apply Permutation_trans with (1 := Permutation_app_head _ IH).
    do 2 rewrite <- app_ass.
    apply Permutation_app; auto.
    apply Permutation_app_comm.
  Qed.

  Fact list_prod_app_right ll mm nn : list_prod ll (mm++nn) ~p list_prod ll mm ++ list_prod ll nn.
  Proof.
    unfold list_prod; rewrite flat_map_app; apply Permutation_refl.
  Qed.

  Fact list_prod_cons_left a ll mm : list_prod (a::ll) mm ~p list_prod (a::nil) mm ++ list_prod ll mm.
  Proof.
    apply (list_prod_app_left (a::nil)).
  Qed.

  Fact list_prod_cons_right ll a mm : list_prod ll (a::mm) ~p list_prod ll (a::nil) ++ list_prod ll mm.
  Proof.
    apply (list_prod_app_right _ (a::nil)).
  Qed.

  Let list_prod_perm_left ll mm nn : ll ~p mm -> list_prod ll nn ~p list_prod mm nn.
  Proof.
    intros; apply flat_map_perm.
    intros; apply Permutation_map; assumption.
  Qed.

  Let list_prod_perm_right nn ll mm : ll ~p mm -> list_prod nn ll ~p list_prod nn mm.
  Proof.
    induction 1 as [ | | | l1 l2 l3 _ IH1 ]; simpl.
    apply perm_nil.
    apply Permutation_app; auto.
    do 2 rewrite app_assoc.
    apply Permutation_app.
    apply Permutation_app_comm.
    apply Permutation_refl.
    apply Permutation_trans with (1 := IH1); auto.
  Qed.

  (* list_prod is congruent under permutations *)

  Fact list_prod_perm l1 l2 m1 m2 : l1 ~p l2 -> m1 ~p m2 -> list_prod l1 m1 ~p list_prod l2 m2.
  Proof.
    intros H1 H2.
    apply Permutation_trans with (1 := list_prod_perm_left _ H1).
    apply list_prod_perm_right; auto.
  Qed.

End list_prod.

Fact list_prod_map A A' B B' C (p : A' -> B' -> C) (f : A -> A') (g : B -> B') l m :
     list_prod (fun a b => p (f a) (g b)) l m = list_prod p (map f l) (map g m).
Proof.
  induction m; simpl; f_equal; auto.
  rewrite map_map; auto.
Qed.

Fact map_list_prod A B C C' (p : A -> B -> C) (f : C -> C') l m : map f (list_prod p l m) = list_prod (fun a b => f (p a b)) l m.
Proof.
  induction m; simpl; f_equal; auto.
  rewrite map_app.
  f_equal; auto.
  rewrite map_map; auto.
Qed.


Definition relation T := T -> T -> Prop.

Definition reflexive {T} (R: relation T) := forall t: T, R t t.
Definition transitive {T} (R: relation T) := forall s t u: T, R s t -> R t u -> R s u.

(* R1 is subset of R2 *)
Definition rel_subset {T} (R1 R2: relation T) :=
  forall a b, R1 a b -> R2 a b.

Definition closure {T} (R Rc: relation T) (P: relation T -> Prop) : Prop :=
  rel_subset R Rc ->
  (forall Rc', (rel_subset R Rc') -> P Rc' -> (rel_subset Rc Rc')).

Definition rel_union {T} (R1 R2: relation T) : relation T :=
  fun a b => R1 a b \/ R2 a b.

Definition eq_rel {T} : relation T := (fun a b => a = b).

Definition reflexive_closure {T} (R: relation T) : relation T :=
  rel_union eq_rel R.

(* ex 2.2.6 *)
Lemma reflexive_closure_proof :
  forall T R, @closure T R (@reflexive_closure T R) reflexive.
Proof.
  intros.
  unfold closure, reflexive_closure, reflexive, rel_subset, rel_union, eq_rel, relation in *.
  intros.
  destruct H2.
  - subst. auto.
  - auto.
Qed.

Fixpoint transitive_closure' {T} (R: relation T) (n : nat) : relation T :=
  match n with
  | 0 => R
  | S n => let Rn := transitive_closure' R n
          in rel_union Rn (fun a b => exists c, Rn a c /\ Rn c b)
  end.

Definition transitive_closure {T} (R: relation T) : relation T :=
  fun a b => exists n, transitive_closure' R n a b.

(* ex 2.2.7 *)
Lemma transitive_closure_proof :
  forall T R, @closure T R (@transitive_closure T R) transitive.
Proof.
  intros.
  unfold closure, transitive_closure, transitive, rel_subset, rel_union, eq_rel, relation in *.
  intros.
  destruct H2 as [n ?].
  generalize dependent a.
  generalize dependent b.
  induction n; intros.
  - auto.
  - simpl in H2.
    unfold closure, transitive_closure, transitive, rel_subset, rel_union, eq_rel, relation in *.
    destruct H2.
    + auto.
    + destruct H2. destruct H2.
      eauto.
Qed.

Definition preserves {T} (R: relation T) (P: T -> Prop) :=
  forall t t', P t -> R t t' -> P t'.

(* ex 2.2.8 *)
Lemma preserves_reflexive_closure :
  forall {T} (R : relation T) (P: T -> Prop),
    preserves R P -> preserves (reflexive_closure R) P.
Proof.
  intros.
  unfold preserves, reflexive_closure, rel_union, eq_rel in *.
  intros.
  destruct H1; subst; eauto.
Qed.


From mathcomp Require Import ssreflect ssrfun ssrnat ssrbool eqtype seq.
From ssrintro Require Import intro.

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

(** Programmers rely on testing to ensure that their code behaves as expected,
    but this is often too weak to catch errors -- as Dijkstra used to put it,
    "testing shows the presence, not the absence of bugs".  In this chapter, we
    will start to use Coq to write precise specifications about programs and
    formally verify that they are valid.

    * Proof by Simplification

    Consider the following (very simple) verification task: we would like to
    ensure that the expression [is_empty Leaf] evaluates to [true].  We can
    state this claim in Coq with the [Lemma] command. *)

Lemma is_empty_leaf : is_empty Leaf = true.

(** This command tells Coq that we want to prove a statement called
    [is_empty_leaf] asserting that [is_empty Leaf] is equal to [true].  We can
    see now that Coq's interface changed a bit, displaying our claim in a
    separate window.  Our goal is to convince Coq that this claim holds.  The
    [Proof] command marks the beginning of our proof.  (It is not needed,
    strictly speaking, but it is considered good style to include it.) *)

Proof.

(** To write proofs, we use special commands called _tactics_.  Each tactic
    transforms the goal a little bit, applying inference steps that (hopefully)
    bring us towards a state where our claim becomes obvious enough to Coq.  Coq
    checks that each argument is sound according to the rules of its logic and
    rejects any invalid proofs.

    Our first tactic is [rewrite /=], which attempts to simplify the current
    goal by roughly expanding definitions and performing trivial computation
    steps.  Recall that we defined [is_empty_left] with a [match] expression
    that returned [true] whenever applied to [Leaf]; thus, it makes sense to try
    to replace [is_empty_leaf Leaf] with [true]. *)

rewrite /=.

(** We can see that the previous goal became [true = true].  This statement is
    obvious enough for Coq to accept without further help.  To complete the
    proof, we use the [done] tactic: *)

done.

(** Coq now tells us that there are no more subgoals, which means that there is
    nothing else left to prove.  We conclude our proof with the [Qed] command,
    records [is_empty_left] as a true statement.  We can convince ourselves that
    Coq believes in our claim by issuing the [Check] command. *)

Qed.

Check is_empty_leaf.

(** This first example property may seem a bit disappointing, given that we
    could have checked it by simply asking Coq to evaluate [is_empty Leaf] for
    us.  In that sense, we have not gained anything compared to a conventional
    testing infrastructure.  For a slightly more interesting example, let us
    prove something about the behavior of _infinitely many programs_: *)

Lemma is_empty_node t1 n t2 : is_empty (Node t1 n t2) = false.
Proof. rewrite /=. done. Qed.

(** To better understand how simplification is performed, consider the following
    function and properties. *)

Definition singleton n := Node Leaf n Leaf.

Lemma tsize1 n : tsize (singleton n) = 1.
Proof.

(** Writing [rewrite -[x]/(y)] instructs Coq to replace all occurrences of [x]
    by [y] in the current goal, provided that both expressions are equivalent
    according to the computation rules of Coq's logic. In the line below, Coq
    understands that both terms are equal because the second is exactly what we
    gave for the definition of [singleton]. *)

rewrite -[singleton n]/(Node Leaf n Leaf).

(** Here, we can see that [rewrite] is a more general tactic that takes many
    possible actions as arguments, which have slightly different effects.

    We can perform a similar exercise for [tsize], and replace the call to it by
    its definition. *)

rewrite -[tsize _]/(match Node Leaf n Leaf with
                    | Leaf => 0
                    | Node t1 _ t2 => tsize t1 + 1 + tsize t2
                    end).

(** Notice that we didn't specify the argument that was given to [tsize], and
    just said [_] instead. Coq can often understand these incomplete patterns
    from the context where they are used.

    Simplifying the [match] expression is easy: since Coq knows the first
    constructor used in the discriminee, it knows which branch to take. Here, we
    use the [LHS] (short for _left-hand side_) pattern instead of writing the
    entire term. *)

rewrite -[LHS]/(tsize Leaf + 1 + tsize Leaf).

(** Similar simplification steps show that [tsize Leaf] evaluates to [0]. *)

rewrite -[tsize Leaf]/(0).

(** At this point, we can conclude. *)

done.
Qed.

(** Calling [done] after a tactic is so common that ssreflect offers special
    syntax for it: if [t] is a tactic, then [by t] tries to execute [t] and to
    conclude the proof afterwards by calling [done]. If the proof cannot be
    complete, Coq raises an error. *)

Lemma tsize1' (n : nat) : tsize (singleton n) = 1.
Proof. by rewrite /=. Qed.

(** As a matter of fact, the above proof is so simple that we don't even need to
    tell Coq to simplify the goal; [done] alone suffices. Alternatively, we can
    also write [by []] (that is, [by] with an "empty" first tactic) as a synonym
    for [done]: *)

Lemma tsize1'' (n : nat) : tsize (singleton n) = 1.
Proof. done. Qed.

Lemma tsize1''' (n : nat) : tsize (singleton n) = 1.
Proof. by []. Qed.

(** Before we move on to more interesting proofs, it is worth leaving a small
    note on naming conventions: ssreflect tries to follow very consistent naming
    conventions for its lemmas, which we will try to emulate here. The [1]
    suffix on [tsize1], for instance, signals that this lemma relates [tsize] to
    something of size [1]; in this case, a singleton tree. We will point to
    other naming conventions as we progress.

    * Using sections

    Coq provides another mechanism for alleviating the burden of annotations:
    _sections_. Sections allow us to declare certain parameters as being common
    to all definitions and lemmas enclosed within it. Inside the section, these
    parameters don't have to be redeclared and applied; when the section is
    closed, on the other hand, all parameters become explicit.

    Sections are opened with the [Section] keyword. Each section must be given a
    name (in this case, [Ex]). *)

Section Ex.

(** Once we are inside a section, we can use the [Variable] command to declare a
    parameter that will be shared by all definitions in the section. *)

Variable T : Type.

(** We can also associate variable names to certain types. After the following
    command, Coq assumes that [x] has type [nat], unless otherwise
    specified. This has the same effect for variables with "similar" names, such
    as [x0] and [x']. *)

Implicit Type x : nat.

(** We can now write statements such as this one: *)

Lemma tsize1'''' n : tsize (singleton n) = 1.
Proof. by []. Qed.

(** Notice that [x] had to be declared in the statement of the lemma, but that
    we didn't have to supply its type. [T], on the other hand, didn't have to be
    declared again.

    If we check the lemma we just proved, we see that [T] is "fixed" (that is,
    not universally quantified): *)

Check tsize1''''.

(** Once we close the [Ex] section, we see that [T] becomes explicitly
    quantified: *)

End Ex.

Check tsize1''''.

(** We will enclose some of the remaining material in a section with some
    variable declarations and implicit types, to make our lives easier. *)

Section Basic.

Variable T : Type.

Implicit Type (t : tree) (x : T).

(** * Proof by case analysis

    Often, simplification is not enough to complete a proof. For instance,
    suppose that we have the following function [troot] which computes the
    element stored in the root of a tree (notice that an empty tree has 0 at its
    root by convention): *)

Definition troot t : nat :=
  match t with
  | Leaf => 0
  | Node _ n _ => n
  end.

(** Clearly, the [tmirror] function defined above does not change the root of
    the tree it is applied to. Let's try to convince Coq of this fact: *)

Lemma troot_tmirror t : troot (tmirror t) = troot t.
Proof.

(** We can try to simplify the goal, but Coq won't be able to make any
    progress. We can also try to use [done], to see if Coq accepts this fact on
    its own, but it raises an error instead: *)

rewrite /=. (* Nothing happens... *)
(* done. *) (* Cannot finish the proof. *)

(** The reason why simplification worked on the previous example, but cannot
    make any progress here, is that Coq knew exactly what shape the result of
    [singleton] has, because its definition started with a [Node]
    constructor. In the current lemma, however, we are trying to prove something
    about an _arbitrary_ tree [t], without any further information about what
    [t] is. What we need is a way to consider all possible forms that [t] can
    have, which we can accomplish with the [case] tactic: *)

case: t.

(** The [case: t] call instructs Coq to do a proof by cases. The proof state now
    shows that we need to complete two subgoals: one where [t] is replaced by
    [Leaf], and another one where it is replaced by a tree that starts with the
    [Node] constructor. We can proceed by proving each of the subgoals in
    sequence. Following the ssreflect convention, we indent the proof of the
    first subgoal by two spaces. Its proof follows by simplification. *)

  rewrite /=.
  by [].

(** The second subgoal looks a little bit different: besides not mentioning [t]
    anymore, our goal now contains additional universally quantified variables,
    the arguments to the [Node] constructor. We can introduce these variables,
    bringing them from the goal into the context by using the [move] tactic: *)

move=> t1 n t2.

(** Each name given after the [=>] operator is used to name one universally
    quantified variable present in the goal. We can now simplify our goal as
    before and conclude. *)

rewrite /=.
by [].
Qed.

(** Ssreflect allows us to combine some of these steps into a single tactic. For
    instance, we can use [case] to name all constructor arguments and perform a
    simplification automatically, like this: *)

Lemma troot_tmirror' t : troot (tmirror t) = troot t.
Proof.
case: t => [|t1 n t2] /=.

(** The pattern enclosed by square brackets in the above tactic names the
    arguments resulting from each constructor of [tree]. In the general case,
    each group of variables separated by [|] corresponds to one
    constructor. Since the [Leaf] constructor doesn't take any arguments, its
    corresponding part in the pattern doesn't contain any variables.

    The [/=] symbol tells Coq to attempt to simplify the goal _after_ doing case
    analysis on [t]. We can see that the resulting goals can be solved
    immediately: *)

  by [].
by [].
Qed.

(** As a matter of fact, we didn't even have to name the constructor arguments,
    since the [done] tactic is smart enough to do this by itself. *)

Lemma troot_tmirror'' t : troot (tmirror t) = troot t.
Proof. by case: t. Qed.

(** Of course, in many cases we _do_ have to perform non-trivial reasoning steps
    after calling [case]. We will encounter many examples of such proofs as we
    make progress.

    * Proof by rewriting

    So far, we have done simple proofs showing that certain equations between
    two expressions hold. We can also use these equations in other proofs to
    show more results. This process is known as _rewriting_.

    The [rewrite] tactic can be used not only with the [/=] symbol, which
    performs simplification by computation, but also with any previously proved
    equation. As a simple example, we can try to prove the following variant of
    [troot_tmirror]: *)

Lemma troot_tmirror2 t : troot (tmirror (tmirror t)) = troot t.
Proof.

(** This result is simple enough that a single call to [case] would suffice to
    solve it, as in [troot_tmirror]. However, we can take a slightly different
    approach, using [troot_tmirror] instead to rewrite on the left-hand side of
    the equation. *)

rewrite troot_tmirror.
rewrite troot_tmirror.
by [].
Qed.

(** As we can see, each call to [rewrite] instantiated the [troot_tmirror]
    lemma with a different tree value, successively removing calls to
    [tmirror]. In the first rewrite, the tree value was instantiated to [tmirror
    t], while in the second one, it was instantiated with [t] itself. Coq
    performs unification to find out how to instantiate each lemma given to
    [rewrite], but we can also explicitly instantiate our lemma by passing the
    value we want to use as an argument to the theorem. This is useful when
    there are multiple possible instantiations and Coq doesn't choose the one we
    want by itself. *)

Lemma troot_tmirror2' t : troot (tmirror (tmirror t)) = troot t.
Proof.
rewrite (troot_tmirror (tmirror t)).
rewrite (troot_tmirror t).
by [].
Qed.

(** It is also possible to perform several rewrite steps at once: *)

Lemma troot_tmirror2'' t : troot (tmirror (tmirror t)) = troot t.
Proof. by rewrite troot_tmirror troot_tmirror. Qed.

(** Alternatively, we can use the [!] flag to rewrite with a lemma as many times
    as possible: *)

Lemma troot_tmirror2''' t : troot (tmirror (tmirror t)) = troot t.
Proof. by rewrite !troot_tmirror. Qed.

(** Finally, we can prefix a lemma with a minus sign [-] to indicate that we
    want to rewrite in the opposite direction: *)

Lemma troot_tmirror2'''' t : troot (tmirror (tmirror t)) = troot t.
Proof.

(* Replace [troot t] by [troot (tmirror t)] *)
rewrite -(troot_tmirror t).

(* Replace [troot (tmirror t)] by [troot (tmirror (tmirror t))] *)
rewrite -(troot_tmirror (tmirror t)).

by [].
Qed.

(** * Proof by induction

    Coq is not smart enough to come up with its own inductive proofs. These are
    done with the [elim] tactic.

    At its simplest form, [elim] is just a more powerful version of [case] that
    generates induction hypothesis for structurally smaller terms. Here's an
    example. Suppose that we wanted to show that [tmirror] is its own
    inverse. *)

Lemma tmirrorK t : tmirror (tmirror t) = t.
Proof.

(** The [K] suffix in the name of this lemma stands for "cancellation", and is a
    convention used by ssreflect to name similar results.

    As with [case], when we call [elim: t], we get to provide names for the
    arguments of each constructor. The difference is that every recursive
    argument also generates an induction hypothesis, saying that the result we
    are trying to prove is valid for that argument. Thus, in the tactic below,
    [IH1] and [IH2] stand for the induction hypotheses that correspond to [t1]
    and [t2]. Notice that we use the [/=] flag to simplify both subgoals. *)

elim: t => [|t1 IH1 x t2 IH2] /=.

(** The first subgoal corresponds to the [t = Leaf] case, and can be solved by
    Coq automatically. *)

  by [].

(** When attacking the second subgoal, where [t] has the form [Node c t1 x t2],
    we can see that our context looks a bit different. Besides the usual
    arguments, it also contains the induction hypotheses [IH1] and [IH2], which
    state that [tmirror (tmirror t1) = t1] and [tmirror (tmirror t2) = t2]. To
    conclude this subgoal, we can rewrite with these hypotheses, as if they were
    normal lemmas: *)

rewrite IH1 IH2.

(** Now, both sides of the equation are equal, and Coq accepts our proof. *)

by [].
Qed.

(** Ssreflect provides nice syntax for simplifying this proof. Since many cases
    in a proof follow directly by simplification, we can use the [//] flag with
    [elim] to tell Coq to try to close all goals it can with the [done]
    tactic. *)

Lemma tmirrorK' t : tmirror (tmirror t) = t.
Proof.
elim: t => [|t1 IH1 x t2 IH2] // /=.
by rewrite IH1 IH2.
Qed.

(** Both [//] and [/=] can be combined in a single flag, [//=]. *)

Lemma tmirrorK'' t : tmirror (tmirror t) = t.
Proof.
elim: t => [|t1 IH1 x t2 IH2] //=.
by rewrite IH1 IH2.
Qed.

(** We can further condense this proof by performing some of the rewriting steps
    directly after calling [elim]. When [->] is given as a name for a
    hypothesis, this tells Coq to try to rewrite with that hypothesis. This
    leads to the following proof: *)

Lemma tmirrorK''' t : tmirror (tmirror t) = t.
Proof. by elim: t => [|/= t1 -> x t2 ->]. Qed.

(** Notice that, before rewriting with the induction hypotheses in the [Node]
    branch, we perform a simplification step with [/=], so that Coq can find the
    terms [tmirror (tmirror t1)] and [tmirror (tmirror t2)] in the goal.

    * Propositions are first-class values

    One interesting aspect of Coq's theory is that propositions are first-class
    values that can be manipulated according to the same rules that are used for
    other objects of the language. In particular, since Coq is a _typed_
    language, all propositions have a type: [Prop]. For instance: *)

Check 1 = 1.

(** Note that being a syntatically well-formed proposition does not imply that
    this proposition is true. Hence, [0 = 1] also has type [Prop], even though
    it corresponds to a false claim. *)

Check 0 = 1.
(** Coq comes with a rich language for writing propositions. So far, we have
    encountered the equality operator [=], and universal quantification
    [forall], but there are many more. We will introduce more of them as we go
    along.

    We can define functions that return propositions, allowing us to develop
    convenient abbreviations for common patterns.

    As an example, we can define a function [cancel] that takes in two functions
    [f] and [g] as arguments, and states that [g] is the left inverse of
    [f]. Since [cancel] is already provided by ssreflect, we restate the
    definition here with a different name, to avoid clashes. *)

Definition cancel' (S R : Type) (f : S -> R) (g : R -> S) : Prop :=
  forall x : S, g (f x) = x.

(** Notice that the [S] and [R] types are explicitly given as arguments to
    [cancel]. However, because of the "implicit arguments" option we enabled at
    the beginning of the file, we don't have to provide them most of the
    time. For instance: *)

Lemma tmirrorK'''' : cancel tmirror tmirror.
Proof.

(** To understand what's going on, it is sometimes useful to unfold the
    definition of [cancel]. Simplification by default does not perform this kind
    of unfolding, because it would create bigger and harder-to-understand proof
    contexts. To unfold a term [foo], we use the [/foo] rewrite flag. For
    instance (even though it won't affect the rest of the proof): *)

rewrite /cancel.

(** Since [cancel] has an explicitly quantified variable [x] in its definition,
    we need to bring it into the context, much like we did after doing case
    analysis. Of course, we can give [x] any name we like: *)

move=> t.
by elim: t => [|/= t1 -> x t2 ->].
Qed.

(** In situations like this, where we want our tactic to act on the first
    quantified value on the goal, we can just call that tactic directly, without
    having to introduce that value directly. In other words, tactics such as
    [case] and [elim] always act implicitly on the first universally quantified
    value in our goal, in stack-like fashion. *)

Lemma tmirrorK''''' : involutive tmirror.
Proof. by elim=> [|/= t1 -> x t2 ->]. Qed.

(** Notice that we have used [involutive tmirror] instead of [tcancel tmirror
    tmirror]. [involutive foo] is defined exactly as [cancel foo foo].

    The reason we wrote [: t] on previous calls to [elim] is simple: the [:] is
    actually a tactic operator, whose effect is to put some variables in the
    context back in the goal. In this sense, it is the inverse of the [=>]
    introduction operator. For instance: *)

Lemma tmirrorK'''''' : involutive tmirror.
Proof.
move=> t.
move: t.
Abort.

(** * Using previous results

    Coq and ssreflect come with many definitions and lemmas about them. In order
    to make effective use of Coq, it is important to know how to reuse this
    infrastructure. Here is a simple example. Suppose that we wanted to prove
    that mirroring a tree does not change its size. *)

Lemma tsize_tmirror t : tsize (tmirror t) = tsize t.
Proof.

(** We could try to prove this by induction: *)

elim: t => [|/= t1 -> x t2 ->] //.

(** Here, we see that Coq was able to discharge the base case by itself, with
    [//]. However, it was not able to get rid of the second one. Indeed, we can
    see that the order of the summands on both sides is different:

    [tsize t2 + 1 + tsize t1 = tsize t1 + 1 + tsize t2]

    Unfortunately, ssreflect's [done] tactic does not perform this kind of
    arithmetic reasoning by itself, and we must find previous results that will
    allow us to show that these two terms are equal. Coq comes with a
    [SearchAbout] command that can be used for looking up lemmas that mention
    certain definitions. In this case, we want to be able to argue about
    commutativity and associativity of [+]. As it turns out, ssreflect already
    these notions for us: *)

Print commutative. (* [C-c C-a C-p] in Proof General *)
Print associative.

(** We can then try to use [SearchAbout] to find lemmas that may help us
    here. *)

SearchAbout "+" commutative. (* [C-c C-a C-a] in Proof General *)
SearchAbout "+" associative.

(** Running these commands shows us that there are two lemmas, [addnC] and
    [addnA], that we can use. You will notice that both lemmas mention a
    function [addn] instead of the [+] operator. Coq comes with a notation
    mechanism for changing the syntax of certain constructs. Thus, natural
    number addition is actually defined as a function [addn], and only later we
    issue a [Notation] command for using the nice infix syntax. Notice also that
    we had to enclose [+] in quotes so that Coq can understand that we are
    referring to a notation as opposed to a normal identifier. We will not
    discuss the details of the [Notation] command right now, though, as it is a
    bit complicated to explain. *)

by rewrite addnC (addnC _ 1) addnA.
Qed.

(** * Hypothetical statements

    So far, we have seen how to prove facts that are always true. In many cases,
    however, we are interested in facts that are only valid when certain
    hypotheses hold. In Coq, we can express such hypothetical statements with
    the implication operator [->]. For example: *)

Lemma tmirror_leaf t : tmirror t = Leaf -> t = Leaf.

(** Each formula preceeding an arrow is a hypothesis that needs to be met for
    the conclusion of the statement (the formula after [->]) to hold. In this
    case, the lemma says that if the result of [tmirror t] is [Leaf], then [t]
    itself must be equal to [Leaf].

    We can use the [=>] operator to name hypotheses that appear in the goal and
    bring them into the context. This allows us to use a hypothesis like we used
    previous lemmas or induction hypotheses: *)

Proof.
move=> e.

(** We can use [tmirrorK] to replace [t] by [tmirror (tmirror t)]. *)

rewrite -(tmirrorK t).

(** Thanks to our hypothesis, we can now bring the goal to a more palatable
    form. *)

rewrite e.

(** Since [tmirror Leaf] is equal to [Leaf] by simplification, Coq can conclude
    directly. *)

by [].
Qed.

(** This shows how to prove hypothetical results. It is also possible to use
    hypothetical results to prove other statements; this in turn requires that
    we prove separately each hypothesis in that statement. *)

Lemma tmirror_leaf2 t : tmirror (tmirror t) = Leaf -> t = Leaf.
Proof.
move=> e.

(** Since the [tmirror_leaf] lemma used below has a hypothesis, the rewrite
    below generates two subgoals: [Leaf = Leaf] and [tmirror t = Leaf]. The
    first one is trivial, and can be discharged directly with [//]. Notice*)

rewrite (@tmirror_leaf t) //.

(** Alternatively, if the goal matches exactly the conclusion of a lemma or
    hypothesis in the context, we can use the [apply] tactic. Once again, if the
    result we apply has any hypotheses, we will have to solve them as separate
    subgoals. *)

apply: tmirror_leaf.
by [].

(** In this case, choosing between [rewrite] and [apply] was (almost) just a
    matter of style. It is important to notice, however, that both tactics are
    usually not interchangeable. [rewrite] only works with statements whose
    conclusions are equalities, and performs a small modification on the
    goal. [apply], on the other hand, works with goals that involve _arbitrary_
    logical constructs, not just equalities. It will be more useful once we
    learn more about Coq's logic.

    Besides using lemmas as functions to specify the value of universally
    quantified variables, we can use function application syntax to supply
    hypotheses. We can use this feature to prove the previous theorem with a
    single call to [apply]. *)

Restart.
move=> e.
by apply: (tmirror_leaf (tmirror_leaf e)).

(** Instead of using [by apply], we can also use [exact]. There are subtle
    differences between the two, but for now we can think of [exact] as a
    shorter version of [by apply]. *)

Restart.
move=> e.
exact: (tmirror_leaf (tmirror_leaf e)).
Qed.

(** * Forward reasoning tactics

    Coq's primary style of interaction is backwards: we progressively simplify
    the goal, until it reaches a state where it can be solved trivially. Often,
    it is more convenient to reason _forward_ instead: progressively deduce more
    and more complex facts from the hypotheses that we have, until some of them
    can apply directly to the goal.

    In ssreflect, the two primary forward-reasoning tactics are [have] and
    [suffices]. When we write [have e: P], Coq adds a new intermediate subgoal
    where it asks for a proof of [P]. Once we complete the proof, it resumes the
    original subgoal, enriching the context with a new hypotheses [e : P]. We
    can use [have] to write an alternative proof of [tmirror_leaf2]: *)

Lemma tmirror_leaf2' t : tmirror (tmirror t) = Leaf -> t = Leaf.
Proof.
move=> e.
have e': tmirror t = Leaf.
  by apply: tmirror_leaf.
by apply: (tmirror_leaf e').

(** It is important to notice that the [:] symbol used in [have] is unrelated to
    the use of [:] in tactics such as [apply], [move] and [case]: in [have], its
    purpose is to state the intermediate result we want to prove, while in the
    other tactics we have seen it moves variables and hypotheses from the
    context into the goal.

    If the intermediate proof used with [have] is short, we can condense it into
    a single tactic, using the [by] keyword. *)

Restart.
move=> e.
have e': tmirror t = Leaf by apply: tmirror_leaf.
by apply: (tmirror_leaf e').

(** The [suffices] tactic is similar to [have]. Its main difference is that it
    reverses the order of the generated subgoals: the first subgoal is augmented
    with the new fact, while the second one asks of the proof of that auxiliary
    fact. Compare: *)

Restart.
move=> e.
suffices e': tmirror t = Leaf.
  by apply: (tmirror_leaf e').
by apply: tmirror_leaf.

(** We are also allowed to merge the proof of the first subgoal into the call to
    [suffices]: *)

Restart.
move=> e.
suffices e': tmirror t = Leaf by apply: (tmirror_leaf e').
by apply: tmirror_leaf.
Qed.

(** The [suffices] tactic is useful when the proof of the auxiliary statement is
    more complicated than the part that uses it. Its name is meant to mimic the
    usual pattern seen in mathematical proofs: "To show A, it suffices to show
    B, because [short argument follows]. Let's then prove B." *)

End Basic.

(** Before discussing more interesting operations on trees, it is worth having a
    tour of some of the basic types and operations provided by Coq and
    ssreflect.

    * Booleans

    Coq defines [bool] as an inductive data type with two constructors: [true]
    and [false]. In that sense, it is equivalent to the definition of the
    [color] type above. *)

Print bool.

(** We can perform case analysis on a boolean with the familiar if-then-else
    syntax: *)

Compute if true then 1 else 2.

(** This form is just a shorthand to an explicit [match]: *)

Compute match true with true => 1 | false => 2 end.

(** Many standard boolean operations are already defined for us. We write [&&],
    [||] and [~~] for the "and", "or", and "not" functions. *)

Check true && true.
Check (true || ~~ false).

(** The [case] tactic can be used to do a proof by cases on members of any
    inductively defined type, including [bool]. *)

Lemma andbF' b : b && false = false.
Proof.

(** Coq cannot solve this goal by itself because [&&] is defined by case
    analysis on its first argument: *)

Print andb.

(** If we do case on [b], on the other hand, the goal becomes trivial. We can
    see that [b] is replaced by [true] and [false] on each generated subgoal: *)

case: b.
  by [].
by [].
Qed.

(** Ssreflect provides an [andbF] lemma whose statement is similar to the one
    above. The name [andbF] means that the lemma talks about what happens when
    we compute the [and] of an arbitrary boolean [b] and [false] ([F]). (Can you
    guess what [andFb] states? What about [andbT]?).

    * Natural numbers

    We have already seen some definitions involving natural numbers. Unlike
    other languages, where numeric types are often primitive, [nat] in Coq is
    just another inductive data type. It is defined as the type having one
    constructor [O], representing zero, and one constructor [S : nat -> nat],
    which represents the successor of a number. *)

Print nat.

(** Coq allows us to write elements of [nat] with conventional arabic
    notation. This feature is just for making programming with [nat] more
    convenient: internally, natural numbers are still represented with [S] and
    [O]. *)

Check 2.
Check S (S O).

(** Additionally, ssreflect uses [n.+1] as special syntax for [S n]: *)

Check 0.+1.+1.

(** We can also use [n.+2], [n.+3] and [n.+4]. *)

Check 0.+2.

(** For instance, here's how we can define a function for computing the
    Fibonacci numbers: *)

Fixpoint fib_aux n acc1 acc2 :=
  if n is n'.+1 then fib_aux n' acc2 (acc1 + acc2)
  else acc2.

Definition fib n := fib_aux n 0 1.

Compute fib 8.

(** This definition also uses a different syntax for doing pattern matching. [if
    e is p then e1 else e2] is just a synonym for [match e with p => e1 | _ =>
    e2]. If it is not obvious for you that this function defines the Fibonacci
    numbers, check the exercise at the end of the chapter.

    We can subtract two numbers by using the [subn] function, written as the
    familiar infix operator [-]. It is worth noting that, because [nat] doesn't
    contain negative values, subtraction on [nat] is _truncated_: if [n] is less
    than [m], then [n - m = 0]. *)

Compute 2 - 4.

(** We can test whether a number is less than other with the [<=] operator: *)

Compute 2 <= 4.
Compute 4 <= 2.

(** We can also write [n < m], which is just special syntax for [n.+1 <= m]. *)

Check (2 + 3).+1 <= 5.

(** When used with a [nat], the [case] tactic behaves similarly to [tree] or
    [bool]: it generates subgoals corresponding to the [O] and [S]
    constructors. The [elim] tactic also works with members of [nat], generating
    an induction hypothesis for the [S] case. Here is a proof of the [addnA]
    lemma we have used above. *)

Lemma addnA' : associative addn.
Proof.
move=> n m p.
elim: n => [|n IH] //=.
rewrite addSn IH.
by [].
Qed.

(** * Sequences

    Like other functional programming languages, ssreflect provides a data type
    [seq] of finite sequences, or lists. To use it, you must import the
    [Ssreflect.seq] library. This type is parameterized over the type of
    elements contained in the sequence; hence, elements of [seq nat] are
    sequences of natural numbers, while elements of [seq bool] are sequences of
    booleans.

    As in other languages, the [seq] type is generated by two constructors:
    [nil], which denotes an empty sequence, and [cons], which adds an element at
    the beginning of some other sequence. For those, Ssreflect provides the
    notations [[::]] and [::]. For example, the sequence consisting of the
    natural numbers [1], [2], and [3] is written as follows: *)

Check 1 :: 2 :: 3 :: [::].

(** Notice that Coq prints the above expression in a slightly different form. In
    ssreflect, we can refer to a literal sequence [e1 :: .. :: en :: [::]] using
    the notation [[:: e1; .. ; en]]: *)

Check [:: 1; 2; 3].

(** The [++] operator concatenates two sequences. *)

Check [:: true; false] ++ [:: true].

(** The [seq] library defines many common operations on sequences for us. The
    familiar [map] function applies some function [f] to all elements of a
    sequence [s]. Here, the [fun n => e] expression is Coq's syntax for an an
    _anonymous function_ that takes [n] as an argument and produces [e] as its
    result. *)

Check map (fun n => [:: n]) [:: 1; 2; 3].

(** Ssreflect has support for a limited form of _list comprehension_ syntax,
    similar to Haskell's. We can see that the above expression is printed
    slightly different by Coq when we execute [Check]: *)

Check [seq [:: n] | n <- [:: 1; 2; 3]].

(** Unfortunately, Coq's notation mechanism is not powerful enough to define a
    flexible, generic equivalent of the list comprehension syntax. Thus,
    ssreflect defines special syntax for only a handful of expressions involving
    sequences. You can read more about them in the documentation of the [seq]
    library.

    Since [seq] is generated by [nil] and [cons], doing case analysis or
    induction on a sequence will generate two cases: one for [nil] and one for
    [cons]. For example: *)

Lemma catA' T : associative (@cat T).
Proof.
move=> s1 s2 s3.
elim: s1 => [|x s1 IH] /=.
  by []. (* [nil] case *)
by rewrite IH. (* [cons] case *)
Qed.

(** (Can you make the above proof shorter?)

    Finally, ssreflect provides an operator [\in] for testing whether an element
    occurs in a sequence. *)

Check 1 \in [:: 1; 2; 3].

(** The [\in] operator is actually defined not just for sequences, but for any
    type supporting a "membership test" operation. In the case of sequences, we
    can only test for membership of elements of some [eqType], which is a Coq
    type equipped with a boolean operation for testing equality. We will come
    back to [eqType] in more detail later; for now, you only need to know that
    ssreflect defines such operations for many basic types, including [nat],
    [seq], among others.

    * Reasoning about constructors

    Intuitively, there are two properties that we expect to hold of data
    constructors. The first one is that constructors are _disjoint_: if we
    construct two values using different constructors, the two values must be
    different. The second one is that constructors are _injective_: whenever two
    expressions involving the same constructor are equal, we can conclude that
    the arguments given to the constructors are equal. These principles are
    validated by Coq's logic, and are useful for proving many results; we
    discuss a few examples here to show how they work.

    Suppose we wanted to prove the following result: *)

Lemma eq_map_nil T S (f : T -> S) s :
  [seq f x | x <- s] = [::] ->
  s = [::].

(** We can argue by case analysis. Since [seq] is generated by [nil] and [cons],
    [s] can have to forms: [[::]] and [x :: s'], for some values [x] and
    [s']. *)

Proof.
case: s=> [|x s'] /=.

(** We can see that the first case was reduced to [[::] = [::] -> [::] =
    [::]]. Since the conclusion is trivial, [done] suffices: *)

  by [].

(** The second case is more interesting: our goal wants us to conclude
    that [x :: s' = [::]], which is clearly false. However, the
    hypothesis in our goal now equates two expressions that start with
    different constructors:

    [f x :: [seq f x' | x' <- s'] = [::]]

    This hypothesis is now absurd, which means that this case can actually never
    occur. The [done] tactic can detect this situation and remove the case from
    further consideration, allowing us to conclude. In logic jargon, this is a
    particular instance of the _principle of explosion_, which states that a
    contradiction entails anything. *)

by [].
Qed.

(** (Can you make this proof shorter?)

    The second principle, injectivity, is not handled by [done] by
    default. Instead, ssreflect provides an introduction form for decomposing an
    equality between expressions with constructors in terms of the arguments
    that appear in it. Here is a simple example: *)

Lemma inj_ex T (x1 x2 y1 y2 : T) :
  [:: x1; y1] = [:: x2; y2] -> x1 = x2.

(** We have seen that we can use the [=>] tactic operator to name hypotheses and
    bring them into the context. If instead of giving it a single name, we give
    a _list_ of names enclosed in brackets [[]], Coq will enumerate all
    equations between arguments that it can infer from that fact, from left to
    right, and name them according to the given list. Thus, the call *)

Proof.
move=> [ex ey].

(** converts the [[:: x1; y1] = [:: x2; y2]] hypothesis into two equations [ex]
    and [ey], asserting [x1 = x2] and [y1 = y2]. The syntax tries to mimic the
    one for case-analysis patterns on purpose. On a data value, the pattern has
    the effect of enumerating all constructors that could have been used to
    produce that value. On an equality, the pattern enumerates all equalities
    that must hold for that one to be valid.

    At this point, we can conclude by rewriting with [e1], or by using
    [done] directly: *)

by [].
Qed.

(** (Can you make this proof shorter?)

    * Using booleans as propositions

    We often want to state facts as an equality between booleans. For instance,
    here's is how we might say that the number [1] occurs in the sequence [[::
    1; 2; 3]]: *)

Lemma bool_prop_ex1 : (1 \in [:: 1; 2; 3]) = true.

(** Since the [\in] operator is defined by a function that computes a boolean,
    Coq can attest that this claim is valid by computation. *)

Proof. by []. Qed.

(** This pattern is so common that ssreflect provides a shorthand for it:
    whenever an expression [e] of type [bool] is used in a context that expects
    an expression of type [Prop], [e] is implicitly converted to [Prop] by
    mapping it to [e = true]. *)

Lemma bool_prop_ex2 : 1 \in [:: 1; 2; 3].

(** This is an instance of a generic feature of Coq called _implicit coercions_,
    which allows certain functions to be implicitly inserted in an expression to
    convert from one type to another. We can have a better sense of what is
    going on by telling Coq to show all coercions that are applied: *)

Set Printing Coercions.

(** We can see that the goal we were trying to prove is actually [is_true (1 \in
    [:: 1; 2; 3])], where [is_true b] is defined as [b = true]. *)

Unset Printing Coercions.

(** Coq treats [is_true b] as if it were an equality. For instance, it can solve
    trivial goals involving [is_true] with [done]. *)

Proof. by []. Qed.

(** It can also rewrite with hypotheses of the form [is_true b], which
    has the effect of replacing [b] by [true]. For instance, we can
    prove the following fact about the boolean "and" operator [&&]: *)

Lemma bool_prop_ex3 (b c : bool) : b -> b && c = c.
Proof. by move=> ->. Qed.

(** Since different constructors are disjoint, we know that [false] cannot occur
    in a hypothesis, because that is synonym with [false = true]. The [done]
    tactic can detect this and similar hypotheses in our context and discharge
    the current goal automatically. Consider the following result: *)

Lemma bool_prop_ex4 n : n <= 0 -> n = 0.
Proof.

(** To put the goal in a shape that can be simplified, we can perform case
    analysis on [n]: *)

case: n => [|n] /=.

(** In the first subgoal, we have to prove [0 = 0], which is trivial: *)

  by [].

(** In the second one, we are left with a contradictory hypothesis, stating that
    [n < 0] (recall that [n < 0] is just notation for [n.+1 <= 0]). We can
    rewrite with [ltn0] lemma from [ssrnat] to replace that hypothesis by
    [false], allowing us to conclude.. *)

rewrite ltn0.
by [].

(** As a matter of fact, we don't even need to call [rewrite], because [n < 0]
    can be "forced" to simplify to [false]: *)

Restart.
by case: n.
Qed.

(** We may also use a boolean to state that a certain proposition is not
    valid. For instance: *)

Lemma bool_prop_ex5 : (4 < 2) = false.
Proof. by []. Qed.

(** However, because of how the coercion from [bool] to [Prop] is defined,
    ssreflect prefers statements of the form [~~ b = true]: *)

Lemma bool_prop_ex6 : ~~ (4 < 2).
Proof. by []. Qed.

(** * Generalizing the induction hypothesis *)

Module Rev.

Section Rev.

Variable T : Type.

Implicit Type s : seq T.

Fixpoint rev s :=
  match s with
  | [::] => [::]
  | x :: s => rev s ++ [:: x]
  end.

Fixpoint tr_rev_aux s acc :=
  match s with
  | [::] => acc
  | x :: s => tr_rev_aux s (x :: acc)
  end.

Definition tr_rev s := tr_rev_aux s [::].

Lemma tr_revE s : tr_rev s = rev s.
Proof.
rewrite /tr_rev -[RHS]cats0.
elim: s [::] => [|x s IH] //= acc.
by rewrite IH -catA.
Qed.

End Rev.

End Rev.

(** * Specifying and verifying a tree operation

    We can use sequences to specify and verify our first interesting tree
    operation: a [tmember] function, that tests whether some element [x] occurs
    on a tree [t], assuming that [t] is a binary search tree -- that is, that
    any element on a node is greater than those on its left subtree and smaller
    than those on its right subtree.

    It would be possible to program [tmember] for any type of elements with a
    comparison operator. However, we will begin with something simpler, and
    define [tmember] only for trees of natural numbers, taking advantage of the
    usual comparison operator [<] defined in the [ssrnat] library. Notice that
    our definition uses [if] expressions, which are defined in the obvious way
    in terms of [match]. *)

Fixpoint tmember (x : nat) (t : tree) : bool :=
  match t with
  | Leaf => false
  | Node t1 x' t2 =>
    if x < x' then tmember x t1
    else if x' < x then tmember x t2
    else true
  end.

(** We will state the specification of [tmember] in terms of a [telems]
    function, which lists all elements that appear in the tree from left to
    right. *)

Fixpoint telems (t : tree) : seq nat :=
  match t with
  | Leaf => [::]
  | Node t1 x t2 => telems t1 ++ x :: telems t2
  end.

(** In order to fully specify the behavior of [tmember], we would have to reason
    about the search-tree invariant. Before getting there, however, we start
    with something simpler: showing that if [tmember x t] is true, then [x] must
    occur in [telems t]. *)

Lemma tmember_sound x t : tmember x t -> x \in telems t.
Proof.

(** It seems a good idea to try to prove this result by induction. *)

elim: t => [|t1 IH1 x' t2 IH2] /=.

(** In the first case ([t = Leaf]), we have to prove that [x] occurs in the
    empty sequence (that is, [telems Leaf]), assuming that [tmember x Leaf] is
    true. While [x] cannot occur in an empty sequence, we can remark that
    [tmember x Leaf] is [false] by definition. This means that we never have to
    consider this case because it can never occur. The [done] tactic can detect
    this and remove this case from consideration for us.  *)

  by [].

(** The second case is more interesting, as we have to consider all possible
    outcomes of comparing [x'] and [x]. The [case] variant below can be used to
    perform case analysis on a value while generating an equation for that
    case. For reasons that soon will become apparent, we will need these
    additional equations later. *)

case e1: (x < x').

(** In the first generated subgoal, we have an additional hypothesis [e1]
    stating [(x < x') = true], and the original compliated premise has been
    simplified to [tmember x t1]. *)

  rewrite mem_cat => e.
  by rewrite (IH1 e).

case e2: (x' < x).

  rewrite mem_cat /= inE.

Admitted.

(** * Exercises: *)

Lemma negbK' : involutive negb.
Proof. Admitted.

Lemma eq_add_0L n m : n + m = 0 -> n = 0.
Proof. Admitted.

Lemma eq_add_0R n m : n + m = 0 -> m = 0.
Proof. Admitted.

(** Hint: The [drop_size_cat] lemma might come in handy. *)
Lemma cat_fact T (s : seq T) : s ++ s = s -> s = [::].
Proof. Admitted.

(** Hint: What is the value of [fib_aux n (x1 + x2) (y1 + y2)]? *)
Lemma fib2 n : fib n.+2 = fib n.+1 + fib n.
Proof. Admitted.


(* NEXT: ===> Extensionality                                                    *)

Require Import Logic.Set.Set.
Require Import Logic.Set.Elem.

Declare Scope Set_Equal_scope.

(* There is one other crucially important relation on 'set' which we have not   *)
(* yet defined, namely that of equality. It is tempting to define equality      *)
(* simply as 'double inclusion'. However, if we assume that equality is not     *)
(* part of a core set theoretic language, but is instead defined in terms of    *)
(* core primitives, the definition we choose should make it obvious that if P   *)
(* is a predicate on sets expressed in the core language, then if two sets x y  *)
(* are deemed equal, the statement P x should be equivalent to the statement    *)
(* P y. For example, if x and y are deemed equal, the statements x :: z and     *)
(* and y :: z should be equivalent for all z. A definition of equality in terms *)
(* of 'double inclusion' would fail to make such equivalence obvious. As we     *)
(* shall see in the 'Extensionality' module, the definition of equality we      *)
(* adopt below is in fact equivalent to 'double inclusion'. However, the point  *)
(* is 'double inclusion' is not the right definition: if x and y are deemed     *)
(* equal, we don't simply want the equivalence 'z :: x <-> z :: y' to hold for  *)
(* all z, we also want the equivalence 'x :: z <-> y :: z'. For any predicate P *)
(* expressed in terms of :: and logical connectives, these two equivalences     *)
(* should ensure that P x <-> P y when x == y (this would need to be formalized *)
(* and proven). In short, for two sets to be equal, we need more than them      *)
(* having identical elements, we also need them to belong to the same sets.     *)
Definition equal (x y:set) : Prop :=
    (forall (z:set), z :: x <-> z :: y)
 /\ (forall (z:set), x :: z <-> y :: z).

Notation "x == y" := (equal x y) (at level 90) : Set_Equal_scope.

Open Scope Set_Equal_scope.

(* Our equality relation is reflexive.                                          *)
Lemma equalRefl : forall (x:set), x == x.
Proof.
    intros x. split; intros z; split; intros H; assumption.
Qed.

(* Our equality relation is symmetric.                                          *)
Lemma equalSym : forall (x y:set), x == y -> y == x.
Proof.
    intros x y [H1 H2]. split; intros z; split; intros H.
    - apply H1. assumption.
    - apply H1. assumption.
    - apply H2. assumption.
    - apply H2. assumption.
Qed.

(* Our equality relation is transitive                                          *)
Lemma equalTrans : forall (x y z:set), x == y -> y == z -> x == z.
Proof.
    intros x y z [H1 H2] [H3 H4]. split; intro t; split; intros H.
    - apply H3, H1. assumption.
    - apply H1, H3. assumption.
    - apply H4, H2. assumption.
    - apply H2, H4. assumption.
Qed.

(* These immediate consequences of equality are sometimes useful in proofs      *)
Lemma elemCompatL : forall (x y z:set), x == y -> x :: z -> y :: z.
Proof.
    intros x y z [H1 H2] H. apply H2. assumption.
Qed.

Lemma elemCompatR : forall (x y z:set), x == y -> z :: x -> z :: y.
Proof.
    intros x y z [H1 H2] H. apply H1. assumption.
Qed.

Lemma elemCompatLR : forall(x x' y y':set),
    x == x' -> y == y' -> x :: y -> x' :: y'.
Proof.
    intros x x' y y' Hx Hy H. apply elemCompatL with x.
    - assumption.
    - apply elemCompatR with y; assumption.
Qed.


Module Stack.

Inductive Stack :=
  | empty
  | Push (e : nat) (s : Stack).

Compute empty : Stack.

Compute Push 1 empty : Stack.

Compute Push 2 (Push 1 empty) : Stack.

Definition s1 : Stack :=
  Push 2 (Push 1 empty).

Compute Push 3 s1 : Stack.

(* Stack Pairs: (e,r) *)
Inductive stackpair : Type :=
  | pair (n : nat) (s : Stack).

Definition fst (p : stackpair) : nat :=
   match p with
   | pair n _ => n
   end.

Definition snd (p : stackpair) : Stack :=
    match p with
    | pair _ s => s
    end.

(*
* Inductive MaybeStackpair : Type :=
*  | Nothing
*  | Just (p : stackpair).
*)
Inductive Maybe (a : Type) : Type :=
  | Nothing
  | Just (x : a).

Check Nothing.

Definition MaybeStackpair : Type := Maybe stackpair .

(* How to pop the stack?
 *
 * | 3 |      Push 3 (
 * | 2 |           Push 2 (
 * | 1 | ===>        Push 1
 * | e |                    empty))
 *)
Definition pop (s : Stack) : Maybe stackpair :=
  match s with
  | empty => @Nothing stackpair
  | Push e s' => Just stackpair (pair e s')
  end.

Definition peek (s : Stack) : Maybe nat :=
  match pop s with
  | Nothing _ => @Nothing  nat
  | Just _ (pair e _) => Just nat e
  end.

Compute pop s1 : stackpair.
Compute peek s1 : nat.