(**
  Autor: Luis Felipe Benítez Lluis
  script de proposiciones a demostrar de la
  sección de lógica clásica  *)
Require Import Classical.
From Tarea2VF Require Export Defs_LC .

(** Lemas *)

Proposition and_not_imply : forall A B : Prop, A /\~ B -> ~ (A -> B).
Proof.
intros A B H.
destruct H.
tercero_ex (~ (A -> B)).
- assumption.
- apply NNPP in H1.
  apply H1 in H.
  contradiction_classic.
Qed.

(* Este teorema se prueba en LM pero usa intros sobre la negación
   por lo que se vuelve a probar en forma clásica para
  evitar usar estas técnicas. No obstante su uso no
  implica que nos salgamos de LM *)
(* From Tarea2VF Require Import Props_LM . *)
(* Check PNNP.*)

Lemma PNNP_classic: forall P: Prop,
  P-> ~~P.
Proof.
  intros.
  tercero_ex (~P).
  contradiction_classic.
  assumption.
Qed.

(* Este teorema puede que sea redundante y ya haya uno
   semejante, pero se vuelve a probar para asegurar no
   usar las técnicas prohibidas*)

Theorem Contrapos_classic :forall P Q: Prop, (P -> Q) <-> (~Q -> ~P).
Proof.
  split.
  + intros.
    tercero_ex (P).
    2:{ assumption. }
    apply H in H1.
    contradiction_classic.
  + intros.
    tercero_ex Q.
    assumption.
    apply H in H1.
    contradiction_classic.
Qed.

Lemma Univ_distr_and_classic:
  forall T ,forall P Q: T -> Prop  , (forall x :T,
  ( P x /\ Q x)) <-> ((forall x:T, P x)/\ (forall x :T, Q x)).
Proof.
  intros.
  split.
  + split.
    intros.
    specialize H with x.
    destruct H.
    assumption .
    intros.
    specialize H with x.
    destruct H.
    assumption .
  + intros.
    destruct H.
    split.
    - specialize H with x.
      assumption.
    - specialize H0 with x.
      assumption.
Qed.

(** Propiedades del operador de cotenabilidad *)
(* Este operador no es nada mas que un 'and' con pasos
   extra. Todas las propiedades son las correspondientes
   a las ya conocidas del operador de conjunción.*)

Lemma cotComm_ida : forall A B : Prop, A ° B -> B ° A.
Proof.
   intros.
   destruct_cot H.
   apply NNPP in H0.
   split_cot.
   * assumption.
   * apply PNNP_classic.
     assumption.
Qed.
Proposition cotComm : forall A B : Prop, A ° B <-> B ° A.
Proof.
  split.
  * apply cotComm_ida.
  * apply cotComm_ida.
Qed.

Proposition cotAsoc: forall A B C : Prop,
  (A ° B) ° C <-> A ° (B ° C).
Proof.
  split.
  + intros.
    destruct_cot H.
    apply NNPP in H0.
    apply imply_to_and in H.
    destruct H.
    apply NNPP in H1.
    split_cot.
    * assumption.
    * apply PNNP_classic.
      tercero_ex ((B -> ~ C)).
      2: {assumption. }
      apply H2 in H1.
      contradiction_classic.
  + intros.
    destruct_cot H.
    apply NNPP in H0.
    apply  imply_to_and in H0.
    destruct H0.
    apply NNPP in H1.
    split_cot.
    * tercero_ex (A -> ~ B).
      2: {assumption. }
      apply H2 in H.
      contradiction_classic.
    * apply PNNP_classic.
      assumption.
Qed.

Proposition cotDist: forall A B C : Prop,
  (A ° B) \/ (A ° C) <-> A ° (B \/ C).
Proof.
  intros.
  split.
  + intros.
    destruct H.
    * destruct_cot H.
      apply NNPP in H0.
      split_cot.
      - assumption.
      - apply PNNP_classic.
        left.
        assumption.
    * destruct_cot H.
      apply NNPP in H0.
      split_cot.
      - assumption.
      - apply PNNP_classic.
        right.
        assumption.
  + intros.
    destruct_cot H.
    apply NNPP in H0.
    destruct H0.
    * left. split_cot. assumption.
      apply PNNP_classic. assumption.
    * right. split_cot. assumption.
      apply PNNP_classic. assumption.
Qed.

Proposition cotFusion: forall A B C : Prop,
  (A-> B -> C)<->((A ° B)->C).
Proof.
  intros.
  split.
  + intros. destruct_cot H0.
    apply NNPP in H1.
    apply H in H0. assumption. assumption.
  + intros.
    apply H.
    split_cot.
    assumption.
    apply PNNP_classic.
    assumption.
Qed.

Proposition cotDefImpl: forall A B : Prop,
  (A -> B)<-> ~(A ° (~ B)).
Proof.
  intros.
  split.
  + intros.
    tercero_ex (A ° (~ B)).
    * destruct_cot H0.
      apply NNPP in H1.
      apply H in H0.
      contradiction_classic.
    * assumption.
  + intros.
    tercero_ex (B).
    assumption.
    contradict H.
    split_cot.
    assumption.
    apply PNNP_classic.
    assumption.
Qed.

(** Argumentos lógicos como proposiciones.*)

Proposition A: forall T,forall a:T, forall A B C: T -> Prop,

  ((exists x:T, (A x /\ B x )) ->
        (forall x :T, (B x -> C x)))

  ->

  (B a /\ ~C a)

  ->

    ~(forall x: T, A x).
Proof.
  intros.
  destruct H0.
  apply ex_not_not_all.
  tercero_ex (A a).
  + assert ( forall x0 : T, B x0 -> C x0).
    apply H; exists a; split; assumption;  assumption.
    specialize H3 with (x0:= a).
    apply H3 in H0.
    contradiction_classic.
  + exists a. assumption.
Qed.

Proposition B: forall T,forall m:T, forall C W: T -> Prop, forall B G: T-> T-> Prop,

  (exists x:T, (~ B x m /\
                           (forall y:T, (C y -> ~ G x y ))))

  ->

  (forall z :T,(~(forall y,(W y -> G z y) )->
                                               B z m) )

  ->

    (forall x, (C x -> ~W x)).
Proof.
  intros.
  destruct H.
  destruct H.
  specialize H0 with (z:= x0).
  apply Contrapos_classic in H0.
  2: { assumption. }
  apply NNPP in H0.
  specialize H2 with (y := x).
  specialize H0 with (y := x).
  apply H2 in H1.
  apply Contrapos_classic in H0.
  2: { assumption. }
  assumption.
Qed.

Proposition C: forall T, forall P H C L R: T-> Prop, forall A B: T -> T -> Prop,

  ((~(forall x:T,(~P x \/ ~H x)))
            ->
              (forall x:T,(C x /\
                                  (forall y: T ,(L y -> A x y)))))
  ->

  ((exists x:T,(H x /\(forall y:T,(L y -> A x y))))
            ->
              (forall x: T,(R x /\
                                  (forall y :T, B x y) )))

  ->
    (~forall x y:T, B x y)->
    (forall x :T,(~P x\/~ H x)).
Proof.
  do 11 intro.
  tercero_ex ((forall x : T, ~ P x \/ ~ H x)).
  assumption.
  assert(forall x : T, C x /\ (forall y : T, L y -> A0 x y)).
  {apply H0.  assumption. }
  apply not_all_ex_not in H3.
  destruct H3.
  apply not_or_and in H3.
  destruct H3.
  apply NNPP in H3.
  apply NNPP in H5.
  specialize H4 with (x:= x).
  destruct H4.
  assert(forall x : T, R x /\ (forall y : T, B0 x y)).
  {  apply H1. exists x. split. assumption. assumption. }
  apply Univ_distr_and_classic in H7.
  destruct H7.
  contradiction_classic.
Qed.


Require Import Coq.Arith.Arith.
Require Import Coq.omega.Omega.

Definition even (n: nat) := exists k, n = 2 * k.
Definition odd  (n: nat) := exists k, n = 2 * k + 1.

Axiom classic : forall P:Prop, P \/ ~ P.

Theorem	easy:	forall	(p	q:	Prop),
p	->	((p->q)	->	p). (*Question 1*)
Proof.
intro p.
intro q.
intro p_lhs.
firstorder.
Qed.

Theorem	Conversion:	forall	(p	q:	Prop),
(p	->	q)	->	(~	p	\/	q). (*Question 2*)
Proof.
intros p q.
intros p_implies_q.
destruct (classic p) as [p_true | p_false].
pose (p_implies_q p_true) as l.
right.
exact l.
left.
exact p_false.
Qed.

Theorem	NotNotAImpA	:	forall	A:	Prop,	~~A	->		A.  (*Question 3*)
Proof.
intro A.
intro double_neg.
destruct (classic A) as [p_true | p_false].
exact p_true.
contradiction.
Qed.

Theorem	PeirceContra:	forall	(p	q:Prop),
~	p	->	~((p		->	q)		->	p). (*Question 4*)
Proof.
intro p.
intro q.
intro H.
destruct (classic p) as [p_true | p_false].
intro r.
pose(H p_true)as d.
exact d.
intro k.
apply H.
intuition.
Qed.

Theorem	Peirce:	forall	(p	q:	Prop),
((p	->	q)	->	p)	->	p. (*Question 5*)
Proof.
intro p.
intro q.
intro r.
destruct (classic p) as [p_true | p_false].
exact p_true.
firstorder.
Qed.


(**
A Gentle Introduction to Type Classes and Relations in Coq
の
Chapter 3. Lost in Manhattan
を SSReflectで書いてみた。

3.7 Deciding Route Equivalence
のEx1'の証明ができることを目標とする。

@suharahiromichi
*)

Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq.
Require Import ssralg ssrint.

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

Import GRing.Theory.                        (* !!! *)
Check addrA.
Check addrC.
Check add0r.

Check (1 + 1)%R.                            (* _ *)
Check 1 + 1.                                (* nat *)
Open Scope ring_scope.
Check 1 + 1.                                (* _ *)

(**
3.2 Data Types and Definitions
*)
(** Types for representing routes in the dicrete  plane *)

Inductive direction : Type :=
  North | East | South | West.
Definition route := list direction.

Record Point : Type :=
  {
    Point_x : int;
    Point_y : int
  }.

Definition Point_O := Build_Point 0 0.

(**
3.3 Route Semantics
 *)
Definition translate (dx dy : int) (P : Point) :=
  Build_Point (Point_x P + dx) (Point_y P + dy).
Check translate : int -> int -> Point -> Point.
Check translate (-1) 1 Point_O : Point.

(** Equality test  between Points *)
Definition Point_eqb (P P': Point) : bool :=
  (Point_x P == Point_x P') &&
  (Point_y P == Point_y P').

(*  move P r follows the route r starting from P *)
Fixpoint move (r:route) (P:Point) : Point :=
  match r with
    | nil => P
    | North :: r' => move r' (translate 0 1 P)
    | East :: r' => move r' (translate 1 0 P)
    | South :: r' => move r' (translate 0 (-1) P)
    | West :: r' => move r' (translate (-1) 0 P)
  end.

(* We consider that two routes are "equivalent" if they define
  the same moves. For instance, the routes
  East::North::West::South::East::nil and East::nil are equivalent *)

Lemma Point_eqb_correct' :
  forall p p', Point_eqb p p' <-> p = p'.
Proof.
  case=> x y.                               (* by p *)
  case=> x' y'.                             (* by p' *)
  split.
  (* -> *)
  rewrite /Point_eqb /=.
  move/andP => [] /eqP Hxx' /eqP Hyy'.
  by rewrite Hxx' Hyy'.

  (* <- *)
  rewrite /Point_eqb /=.
  case=> Hxx' Hyy'.
  by apply/andP; split; [rewrite Hxx' | rewrite Hyy'].
Qed.

Lemma PointEqP p p' : reflect (p = p') (Point_eqb p p').
Proof.
  apply: (@iffP (Point_eqb p p')).
  - by apply: idP.
  - by rewrite (Point_eqb_correct' p p').
  - by rewrite (Point_eqb_correct' p p').
Qed.

(* Point_eqb_correct の別の証明 *)
(* バニラCoqの andb_true_iff だが、andP を直接使えばよい。 *)
Lemma andb_true_iff :
  forall b1 b2 : bool, b1 && b2 = true <-> b1 = true /\ b2 = true.
Proof.
  move=> b1 b2.
  split => H.
  by apply/andP.
  by apply/andP.
Qed.

Lemma int_eq_boolP (a b : int) :
  reflect (a = b) (a == b).
Proof.
  by apply/eqP.
Qed.

(* Prove the correctness of Point_eqb *)
Lemma Point_eqb_correct :
  forall p p', Point_eqb p p' = true <-> p = p'.
Proof.
  move=> p p'.
  elim: p; elim: p'; split.
  - rewrite /Point_eqb //=.
    move/andP.
    elim.
    move/int_eq_boolP => H1.
    move/int_eq_boolP => H2.
      by rewrite H1; rewrite H2.
  - elim.
    rewrite /Point_eqb //=.
    apply/andP.
    split.
      by apply/int_eq_boolP.
      by apply/int_eq_boolP.
Qed.

(* *************************** *)

(* Point_O が固定であることに注意。ここでは、このboolを中心に使っていく。 *)
Definition route_eqb r r' : bool :=
  Point_eqb (move r Point_O) (move r' Point_O).
Infix "=r==" := route_eqb (at level 70):type_scope.

Example Ex1'' : East::North::West::South::East::nil =r== East::nil.
Proof.
  apply Point_eqb_correct.
  by [].
Qed.

(* *************************** *)
(**
3.4 On Route Equivalence
*)
Check rel route.
Check reflexive.
Check reflexive route_eqb.
Lemma route_eqb_refl : reflexive route_eqb.
Proof.
  move=> r.
  apply/andP; by [].
Qed.

Lemma route_eqb_sym : symmetric route_eqb.
Proof.
  move=> r y.
  rewrite /route_eqb.
  apply/idP/idP;
    move/PointEqP => H;
      by apply/PointEqP.
Qed.

Lemma route_eqb_trans : transitive route_eqb.
Proof.
  move=> r x z.
  rewrite /route_eqb.
  move/PointEqP => H1;
  move/PointEqP => H2;
  apply/PointEqP.
  by rewrite H1 H2.
Qed.

Lemma route_eqb_Eqb : equivalence_rel route_eqb.
Proof.
  split.
  - apply: route_eqb_refl.
  - move=> H1.
    apply/idP/idP => H2.
    Check @route_eqb_trans x y z.
    + apply: (@route_eqb_trans x y z).
      Check @route_eqb_sym y x.
      * by rewrite (@route_eqb_sym y x).
      * by apply: H2.
    Check @route_eqb_trans y x z.
    + apply: (@route_eqb_trans y x z).
      * by apply: H1.
      * by apply: H2.
Qed.

(* route_eqb (=r==) を使う場合。 *)
Example Ex2' : South::East::North::West::South::East::nil =r== South::East::nil.
Proof.
  (* apply: route_cons. *)
  by apply: Ex1''.
Qed.

Example Ex3' : forall r, North::East::South::West::r =r== r.
Proof.
  move=> r.
  apply/PointEqP.
  by rewrite //=.
Qed.

Example Ex4' : forall r r', r =r== r' ->
                North::East::South::West::r =r== r'.
Proof.
  by [].
Qed.

(* ****************** *)
(* route_equiv と route_eqb の reflect を証明する *)
(* ****************** *)

(* これは、SSReflect の rel ではない。 *)
Definition route_equiv (r r' : route) :=
  forall (P : Point), (move r P) = (move  r' P).
Check route_equiv : route -> route -> Prop.
Infix "=r=" := route_equiv (at level 70):type_scope.

(**
3.6 Some Other instances of Proper
*)
Lemma route_compose :
  forall r r' P, move (r ++ r') P = move r' (move r P).
Proof.
  induction r as [|d s IHs]; simpl;
  [auto | destruct d; intros;rewrite IHs;auto].
Qed.

Check (1 - 1).
Search (_ - _).
Check subr_eq.

Lemma test_sub_eq (x y z : int) :           (* 使っていない *)
  x = y + z -> x - z = y.                   (* %R *)
Proof.
  move/eqP => H.
  apply/eqP.
  by rewrite subr_eq.
Qed.

Lemma test_sub_eq0 (x y : int) :            (* 使っていない *)
  x = y -> x - y = 0.                       (* %R *)
Proof.
  move/eqP => H.
  apply/eqP.
  by rewrite subr_eq0.
Qed.

Example Ex3 : forall r, North::East::South::West::r =r= r.
Proof.
  intros r P;
  case: P => //=.
  rewrite /translate => //= Px0 Py0.
  congr (move r _).                         (* f_equal *)
  congr (Build_Point _ _).                  (* f_equal *)
  - do 2! rewrite addr0. apply/eqP. by rewrite subr_eq.
  - do 2! rewrite addr0. apply/eqP. by rewrite subr_eq.
Qed.

Lemma translate_comm :
  forall dx dy dx' dy' P,
    translate dx dy (translate dx' dy' P) = translate dx' dy' (translate dx dy P).
Proof.
  rewrite /translate //=.
  move=> dx dy dx' dy' P.
  apply Point_eqb_correct'.
  rewrite /Point_eqb //=.
  apply/andP.
  do 4! rewrite -[_ + _ + _]addrA.                   (* %R *)
  by split; apply/eqP; congr (_ + _); rewrite addrC. (* %R *)
Qed.

Lemma move_translate :
  forall r P dx dy,
    move r (translate dx dy P) = translate dx dy (move r P).
Proof.
  induction r as [|a r]; simpl; [reflexivity|].
  destruct a;simpl; intros;rewrite <- IHr;rewrite  (translate_comm); auto.
Qed.

Lemma move_comm :
  forall r r' P,
    move r (move r' P) =  move r' (move r P).
Proof.
  induction r as [| a r']; [reflexivity|].
  simpl; destruct a;
  intros; repeat rewrite move_translate; rewrite IHr'; auto.
Qed.

Lemma app_comm : forall r r', r++r' =r=  r'++r.
Proof.
  intros r r' P; repeat rewrite route_compose; apply move_comm.
Qed.

(** the following lemma  will be used for deciding route equivalence *)
Lemma route_equiv_Origin :
  forall r r', r =r= r' <-> move r Point_O  = move r' Point_O .
Proof.
  move=> r r'.
  split; intro H.
  rewrite H; trivial.
  intro P; replace P with (translate (Point_x P) (Point_y P) Point_O).
  repeat rewrite move_translate.
  rewrite H; reflexivity.
  destruct P; simpl; unfold translate; f_equal; simpl.
  by rewrite add0r.
  by rewrite add0r.
Qed.

(**  ... we can now prove route_eqb's  correctness *)
Lemma route_equiv_equivb :
  forall r r',
    route_equiv r r' <-> route_eqb r r' = true.
Proof.
  intros r r'; rewrite route_equiv_Origin;
  unfold route_eqb; rewrite Point_eqb_correct; tauto.
Qed.

Ltac route_eq_tac := rewrite route_equiv_equivb; reflexivity.

(** another proof of Ex1, using computation  *)
Example Ex1' : East::North::West::South::East::nil =r= East::nil.
Proof.
  route_eq_tac.
Qed.

Lemma route_equivP (r r' : route) :
  reflect (route_equiv r r') (route_eqb r r').
Proof.
  apply: (@iffP (route_eqb r r')).
  - by apply: idP.
  - by apply (route_equiv_equivb r r').
  - by apply (route_equiv_equivb r r').
Qed.

Example Ex1 : East::North::West::South::East::nil =r= East::nil.
Proof.
  apply/route_equivP.
  by [].
Qed.

(* Ex5 は、=r= による rewrite を使うので、この範囲では解けない。 *)
Example Ex5' : forall r r',  r =r= r' -> r ++ North::East::South::West::r' =r= r ++ r'.
Proof.
  move=> r r' H.
  (* rewrite H. *)
  admit.                                    (* OK *)
Qed.

(* END *)


Require Export "Prop".

Inductive ex (X : Type) (P : X -> Type) : Prop :=
  ex_intro: forall (witness : X), P witness -> ex X P.

Notation "'exists' x , p" := (ex _ (fun x => p))
  (at level 200, x ident, right associativity) : type_scope.
Notation "'exists' x : X , p" := (ex _ (fun x:X => p))
  (at level 200, x ident, right associativity) : type_scope.

Example exists_example_1 : exists n, n + (n × n) = 6.
Proof.
  apply ex_intro with (witness := 2).
  reflexivity.
Qed.

Example exists_example_1' : exists n, n + (n × n) = 6.
Proof.
  exists 2. reflexivity.
Qed.

Theorem exists_example_2 : forall n,
  (exists m, n = 4 + m) ->
  (exists o, n = 2 + o).
Proof.
  intros n H. inversion H as [m Hm].
  exists (2 + m). assumption.
Qed.

Lemma exists_example_3 : exists (n:nat), even n /\ beautiful n.
Proof.
  exists 8. split.
  Case "left". unfold even. reflexivity.
  Case "right". apply b_sum with (n := 3) (m := 5). apply b_3. apply b_5.
Qed.

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

Theorem dist_exists_or : forall (X : Type) (P Q : X -> Prop),
  (exists x, P x \/ Q x) <-> (exists x, P x) \/ (exists x, Q x).
Proof.
  intros X P Q. split.
  Case "left".
  {
    intros H. inversion H as [m Hm]. inversion Hm as [Hp | Hq].
    SCase "left". left. exists m. assumption.
    SCase "rigth". right. exists m. assumption.
  }
  Case "right".
  {
     intros H. inversion H as [Hp | Hq].
     inversion Hp.
     SCase "left". exists witness. left. assumption.
     inversion Hq.
     SCase "rigth". exists witness. right. assumption.
  }
Qed.

Inductive sumbool (A B : Prop) : Set :=
| left : A -> sumbool A B
| right : B -> sumbool A B.

Notation "{ A } + { B }" := (sumbool A B) : type_scope.

Theorem eq_nat_dec : forall n m : nat, {n = m} + {n <> m}.
Proof.
  intros n. induction n.
  Case "n = O".
  {
    intros m. destruct m.
    SCase "m = O". apply left. reflexivity.
    SCase "m = S m". apply right. intros H. inversion H.
  }
  Case "n = S n".
  {
    intros m. destruct m.
    SCase "m = O". apply right. intros H. inversion H.
    SCase "m = S m". destruct IHn with (m := m) as [Heq | Hneq].
    apply left. apply f_equal. assumption.
    apply right.  intros H. inversion H. apply Hneq. assumption.
  }
Qed.

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

Theorem override_same' : forall (X : Type) x1 k1 k2 (f : nat -> X),
                           f k1 = x1 -> (override' f k1 x1) k2 = f k2.
Proof.
  intros X x1 k1 k2 f H. unfold override'.
  destruct (eq_nat_dec k1 k2). rewrite <- H. apply f_equal. assumption.
  reflexivity.
Qed.

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

Inductive all (X : Type) (P : X -> Prop) : list X -> Prop :=
| empty : all X P []
| cons : forall (x : X) (xs : list X),  P x -> all X P xs -> all X P (x :: xs).

Fixpoint forallb {X : Type} (test : X -> bool) (l : list X) : bool :=
  match l with
    | [] => true
    | x :: l' => andb (test x) (forallb test l')
  end.

Theorem forallb_and_all :
  forall (X : Type) (test : X -> bool) (l : list X),
    forallb test l = true <-> all X (fun x => test x = true) l.
Proof.
  intros X test l. split.
  Case "->".
  {
    induction l.
    SCase "[]". intros H. apply empty.
    SCase "Cons n l". simpl. intros H. apply cons. destruct (test x).
    reflexivity. inversion H. apply andb_prop in H. inversion H. apply IHl.
    assumption.
  }
  Case "<-".
  {
    intros H. induction H.
    SCase "empty". reflexivity.
    SCase "cons". simpl. apply andb_true_intro. split. assumption.
    assumption.
  }
Qed.

Inductive merge {X : Type} : list X -> list X -> list X -> Prop :=
| emptym : merge [] [] []
| firstm : forall (x : X) (l m n : list X), merge l m n -> merge (x :: l) m (x :: n)
| secondm : forall (x : X) (l m n : list X), merge l m n -> merge l (x :: m) (x :: n).

Theorem filter_challenge : forall (X:Type) (test: X->bool) (l1 l2 l:list X),
  merge l1 l2 l ->
  all X (fun x => test x = true) l1 ->
  all X (fun x => test x = false) l2 ->
  filter test l = l1.
Proof. Abort.

Inductive appears_in {X : Type} (a : X) : list X -> Prop :=
| ai_here : forall l, appears_in a (a :: l)
| ai_later : forall b l, appears_in a l -> appears_in a (b :: l).

Lemma appears_in_app : forall (X : Type) (xs ys : list X) (x : X),
   appears_in x (xs ++ ys) -> appears_in x xs \/ appears_in x ys.
Proof.
 intros X xs ys x H. induction xs.
 Case "nil". right. assumption.
 Case "Cons n l".
 {
   inversion H.
   SCase "left". left. apply ai_here.
   SCase "right".  apply IHxs in H1. inversion H1. left. apply ai_later.
   assumption.  right. assumption.
 }
Qed.

Lemma app_appears_in : forall (X:Type) (xs ys : list X) (x : X),
     appears_in x xs \/ appears_in x ys -> appears_in x (xs ++ ys).
Proof.
  intros X xs ys x H. destruct H.
  induction xs. inversion H. inversion H.
  constructor. simpl. constructor. auto.
  induction xs. assumption.
  simpl. constructor. assumption.
Qed.


(* "Accept this definition without proof" *)
Definition admit {T: Type} : T.  Admitted.

Inductive day : Type :=
  | monday : day
  | tuesday: day
  | wednesday : day.

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

(*Eval compute in (next_weekday monday).*)

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

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

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

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

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

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

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

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

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

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

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

Example test_andb31: (andb3 true true true) = true.
Proof.
  simpl.
  reflexivity.
Qed.

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

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

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

(*
Check true.

Check (negb true).

Check test_andb34.
*)

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

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

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

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

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

Example plus_works: plus 2 3 = 5.
Proof. reflexivity. Qed.

Example sub_works: sub 5 3 = 2.
Proof. reflexivity. Qed.

Example sub_zero: sub 3 5 = 0.
Proof. reflexivity. Qed.

(* Eval compute in (plus (S (S (S O))) (S (S O))). *)

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

(* Check ((0 + 1) + 1). *)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Theorem andb_f_l : forall (x : bool), andb false x = false.
Proof.
  intros x.
  reflexivity.
Qed.

Theorem andb_f_r : forall (x : bool), andb x false = false.
Proof.
  intros x.
  destruct x.
  reflexivity.
  reflexivity.
Qed.

Theorem andb_t_l : forall (x : bool), andb true x = x.
Proof.
  intros x.
  reflexivity.
Qed.

Theorem andb_t_r : forall (x : bool), andb x true = x.
Proof.
  intros x.
  destruct x.
  reflexivity.
  reflexivity.
Qed.

Theorem orb_t_l : forall (x : bool), orb true x = true.
Proof.
  intros x.
  reflexivity.
Qed.

Theorem orb_t_r : forall (x : bool), orb x true = true.
Proof.
  intros x.
  destruct x.
  reflexivity.
  reflexivity.
Qed.

Theorem orb_f_l : forall (x : bool), orb false x = x.
Proof.
  intros x.
  reflexivity.
Qed.

Theorem orb_f_r : forall (x : bool), orb x false = x.
Proof.
  intros x.
  destruct x.
  reflexivity.
  reflexivity.
Qed.

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

Inductive bin : Type :=
  | B0 : bin
  | B1 : bin -> bin
  | B2 : bin -> bin.

Fixpoint bin_to_nat (b : bin) : nat :=
  match b with
    | B0 => 0
    | B1 b' => 2 * (bin_to_nat b')
    | B2 b' => (2 * (bin_to_nat b')) + 1
  end.

Fixpoint bin_incr (b : bin) : bin :=
  match b with
    | B0 => B2 B0
    | B1 b' => B2 b'
    | B2 b' => B1 (bin_incr b')
  end.

Fixpoint nat_to_bin (n : nat) : bin :=
  match n with
    | 0 => B0
    | S n => bin_incr (nat_to_bin n)
  end.

Example nbn_0: bin_to_nat (nat_to_bin 0) = 0.
Proof. reflexivity. Qed.

Example nbn_1: bin_to_nat (nat_to_bin 1) = 1.
Proof. reflexivity. Qed.

Example nbn_2: bin_to_nat (nat_to_bin 2) = 2.
Proof. reflexivity. Qed.

Example nbn_3: bin_to_nat (nat_to_bin 3) = 3.
Proof. reflexivity. Qed.

Example nbn_4: bin_to_nat (nat_to_bin 4) = 4.
Proof. reflexivity. Qed.

Example nbn_5: bin_to_nat (nat_to_bin 5) = 5.
Proof. reflexivity. Qed.

Lemma plus_0_r : forall n : nat, n + 0 = n.
Proof.
  intros n.
  induction n as [| n'].
  reflexivity.
  simpl.
  rewrite IHn'.
  reflexivity.
Qed.

Lemma plus_0_l : forall n : nat, 0 + n = n.
Proof.
  intros n.
  induction n as [| n'].
  reflexivity.
  simpl.
  reflexivity.
Qed.

Lemma whatever: forall n m : nat, m + S n = S (m + n).
Proof.
  intros n m.
  induction m as [|m'].
  rewrite plus_0_l.
  rewrite plus_0_l.
  reflexivity.
  simpl.
  rewrite IHm'.
  reflexivity.
Qed.

Lemma plus_comm : forall n m : nat, n + m = m + n.
Proof.
  intros m n.
  induction n as [|n'].
  rewrite plus_0_r.
  rewrite plus_0_l.
  reflexivity.
  assert (H2: n' + m = m + n').
    symmetry.
    assumption.
  simpl.
  rewrite H2.
  simpl.
  rewrite whatever.
  reflexivity.
Qed.

Lemma plus_assoc : forall n m o : nat, n + (m + o) = (n + m) + o.
Proof.
  intros n m o.
  induction n as [|n'].
  rewrite plus_0_l.
  rewrite plus_0_l.
  reflexivity.
  simpl.
  rewrite IHn'.
  reflexivity.
Qed.

Lemma binary_unary_inc_commute : forall b : bin,
  bin_to_nat (bin_incr b) = (bin_to_nat b) + 1.
Proof.
  intros b.
  induction b.
  reflexivity.
  simpl.
  rewrite plus_0_r.
  reflexivity.
  simpl.
  rewrite plus_0_r.
  rewrite plus_0_r.
  rewrite IHb.
  remember (bin_to_nat b) as x.
  rewrite plus_assoc.
  assert (H2: x + 1 + x = x + x + 1).
    rewrite plus_comm.
    rewrite plus_assoc.
    reflexivity.
  rewrite H2.
  reflexivity.
Qed.

Theorem nat_to_bin_to_nat: forall n : nat, bin_to_nat (nat_to_bin n) = n.
Proof.
  induction n.
  reflexivity.
  simpl.
  rewrite binary_unary_inc_commute.
  rewrite IHn.
  rewrite plus_comm.
  reflexivity.
Qed.


(* "Human" is a thing. *)
Axiom Human  : Type.
(* "This human is mortal" is a proposition. *)
Axiom Mortal : Human -> Prop.

(* It is given that "all humans are mortal" has a proof. *)
Axiom all_humans_mortal :
  forall h : Human, Mortal h.

(* It is given that Socrates is a human *)
Axiom socrates : Human.

(* It results that Socrates is mortal *)
Theorem socrates_mortal : Mortal socrates.
Proof.
  exact (all_humans_mortal socrates).
Qed.


Require Import List.
Require Import Omega.

(******************************************************************************)
(**************************** DM COQ 2019-2020 ********************************)
(******************************************************************************)
(******************************************************************************)
(***************************# Adrien BLASSIAU #********************************)
(***************************# Corentin JUVIGNY #*******************************)
(******************************************************************************)
(******************************************************************************)
(******* PREUVES RÉUSSIES : 41 ************************************************)
(******* PREUVES ADMISES :   7 ************************************************)
(******************************************************************************)

(******************************************************************************)
(******************************************************************************)
(********************** Exercice 1 (Listes et comptage) ***********************)
(******************************************************************************)
(******************************************************************************)
(****** PREUVES RÉUSSIES : 7 **************************************************)
(****** PREUVES ADMISE :   1 **************************************************)
(******************************************************************************)

(** Dans la suite on travaille avec un type A quelconque muni d’une égalité
    décidable. Pour les tests, on utilise nat. **)

Variable A : Type.
(**Definition A := nat.**)

Hypothesis dec_A : forall (x y : A), ({x=y}+{~x=y}).
(**Definition dec_A := Nat.eq_dec.**)

(****************)
(** Question 1 **)
(****************)

(** occ prend en argument un élément x de type A et une liste l de type (list A)
    et retourne le nombre d’occurrences de x dans l. **)
Fixpoint occ (x : A) (l : list A) :=
  match l with
   | nil => O
   | x' :: l' =>(
   match dec_A x' x with
   | left _ => S (occ x l')
   | right _ => occ x l'
   end)
  end.
Check occ.
(** TESTS
  Eval compute in (occ 0 (cons 4 (cons 4 (cons 3 (cons 1 (cons 2 (cons 4 nil))))))).
  Eval compute in (occ 4 (cons 4 (cons 4 (cons 3 (cons 1 (cons 2 (cons 4 nil))))))).
  Eval compute in (occ 4 nil).
**)

(****************)
(** Question 2 **)
(****************)

Theorem occ_app : forall (x : A) l1 l2,
occ x (app l1 l2) = (occ x l1) + (occ x l2).
Proof.
 intros x l1 l2.
 induction l1.
 + simpl. reflexivity.
 + simpl. destruct (dec_A a x).
   - simpl. rewrite IHl1. reflexivity.
   - rewrite IHl1. reflexivity.
Qed.

(****************)
(** Question 3 **)
(****************)

Theorem occ_filter : forall (P : A -> bool) (a : A) l,
occ a (filter P l) = if (P a) then occ a l else 0.
Proof.
 intros P a l.
 induction l.
 + case_eq (P a).
   - intros H. simpl. reflexivity.
   - simpl. reflexivity.
 + case_eq (P a) ;intros H2 ; rewrite H2 in IHl.
   - case_eq (dec_A a0 a).
     * intros H3 H4. simpl. rewrite H3. rewrite H2. rewrite H3 in H4.
       simpl. rewrite H4. rewrite IHl. reflexivity.
     * intros n H3. simpl. rewrite H3.
       case_eq(P a0) ; intros H4.
       ** simpl. rewrite H3. assumption.
       ** assumption.
   - simpl. case_eq (dec_A a0 a).
     * intros H7. intros H8. rewrite H7. rewrite H2. assumption.
     * intros H1 H3.
       case_eq(P a0) ; intros H4.
       ** simpl. rewrite H3. assumption.
       ** assumption.
Qed.

(****************)
(** Question 4 **)
(****************)

(** map applique une fonction f de type A -> A sur tous les éléments d’une liste. **)
Fixpoint map (f : A -> A) (l : list A) :=
  match l with
   | nil => nil
   | x' :: l' => cons (f x') (map f l')
  end.
Check map.
(** TESTS
  Eval compute in (map (fun x => x+1) (cons 4 (cons 4 (cons 3 (cons 1 (cons 2 (cons 4 nil))))))).
**)

(** L'énoncé semble éronné. Si on prend deux éléments y et z distinct dans
    l'ensemble A, on peut construire une fonction f qui rend l'énoncé faux ! **)
Theorem occ_map : forall (y:A) (z:A), y<>z -> exists (f : A -> A) (x : A) (l : list A),
occ (f x) (map f l) <> occ x l.
Proof.
 intros y z H.
 exists (fun x => y). exists (y). exists (cons y (cons z nil)). simpl.
 unfold not. intros H1.
 case_eq (dec_A y y).
 + intros e H2. rewrite H2 in H1.
   case_eq(dec_A z y).
   - intros e0 H3. pose(e':=e0). symmetry in e'. contradiction.
   - intros n H3. rewrite H3 in H1. omega.
 + contradiction.
Qed.

(****************)
(** Question 5 **)
(****************)

Inductive mem : A -> list A -> Prop :=
| mem_cons : forall x l, mem x (cons x l)
| mem_tail : forall x y l, mem x l -> mem x (cons y l).

(** Un preuve intermédiaire ... **)
Lemma mem_diff : forall (l : list A) (x : A) (y : A), mem x (cons y l) -> x <> y -> mem x l.
Proof.
 intros l x y H1. induction l ;
 intros H.
 + inversion H1.
   - contradiction.
   - assumption.
 + inversion H1.
   - apply mem_tail. rewrite <- H3. apply IHl.
     * rewrite H3. apply mem_cons.
     * assumption.
   - assumption.
Qed.

Theorem mem_null_1 : forall (l : list A) (x : A), occ x l = 0 -> ~(mem x l).
Proof.
 induction l ; simpl.
 + intros x H. unfold not. intros H1. inversion H1.
 + intros x.
   case_eq (dec_A a x).
   - intros e H1 H2. inversion H2.
   - intros n H1 H2. unfold not. intros H3. pose (IHl2 := IHl x). unfold not in IHl2.
     apply IHl2.
     * rewrite H2. reflexivity.
     * apply mem_diff with (y:=a).
       apply H3. unfold not. intros H4. symmetry in H4. contradiction.
Qed.

Theorem mem_null_2 : forall (l : list A) (x : A), ~(mem x l) -> occ x l = 0.
Proof.
 intros l x H. unfold not in H.
 induction l ; simpl.
 + reflexivity.
 + case_eq (dec_A a x).
   - intros e H2. rewrite e in H. pose(H3:= mem_cons x l). pose(H':=H H3).
     destruct H'.
   - intros n H1. apply IHl. intros H2. apply mem_tail with (y:=a) in H2. apply H.
     assumption.
Qed.

(****************)
(** Question 6 **)
(****************)

Inductive nodup : list A -> Prop :=
| nodup_nil : nodup nil
| nodup_tail : forall x l, ~mem x l -> nodup l -> nodup (cons x l).

Theorem doublon_1 : forall (l : list A) (x : A), nodup l -> occ x l <= 1.
Proof.
 intros l x H.
 induction l.
 + simpl. omega.
 + inversion H. unfold not in H2. simpl.
   case_eq (dec_A a x).
   * intros e H4. pose (H':=IHl H3). rewrite e in H2. apply mem_null_2 in H2.
     rewrite H2. omega.
   * intros n H4. apply IHl.
     assumption.
Qed.

(** Nous n'avons pas réussi à démontrer la preuve dans ce sens ... **)
Theorem doublon_2 : forall (l : list A) (x : A), occ x l <= 1 -> nodup l.
Proof.
 intros l.
 induction l ; intros x H.
 + apply nodup_nil.
 + simpl in H.
   case_eq (dec_A a x).
   - intros e H1. rewrite H1 in H.
     apply (nodup_tail).
     * unfold not. intros H2.
       case_eq(Nat.eq_dec (occ x l) 0).
       ** intros e0 H3. pose(H4:=mem_null_1 l x). pose(H5:=H4 e0).
          rewrite <- e in H5. contradiction.
       ** intros n H3. omega.
     * apply (IHl x). omega.
   - intros n H1.
     apply nodup_tail.
     * unfold not. intros H2. rewrite H1 in H. pose(H':=IHl x). pose(H'':=H' H).
       inversion H2.
Admitted.

(******************************************************************************)
(******************************************************************************)
(*************** Exercice 2  (Implantation des multi-ensembles) ***************)
(******************************************************************************)
(******************************************************************************)
(****** PREUVES RÉUSSIES : 34 *************************************************)
(****** PREUVES ADMISES :   6 *************************************************)
(******************************************************************************)

(** Dans la suite on travaille avec un type T quelconque muni d’une égalité
    décidable. Pour les tests, on utilise nat. **)

Variable T : Type.
(**Definition T := nat.**)

Hypothesis T_eq_dec : forall (x y : T), {x=y} + {~x=y}.
(**Definition T_eq_dec := Nat.eq_dec.**)

(******************************************************************************)
(****2.1 Implantation des multi-ensembles à l’aide de listes d’association*****)
(******************************************************************************)
(****** PREUVES RÉUSSIES : 18 *************************************************)
(****** PREUVES ADMISES :   6 *************************************************)
(******************************************************************************)

(****************)
(** Question 1 **)
(****************)

Definition multiset := list (T*nat).

(** empty est le multiset vide. **)
Definition empty : multiset := nil.
Check empty.
(** TEST
  Eval compute in empty.
**)

(** singleton x crée le multi-ensemble qui ne contient que x en un seul exemplaire **)
Definition singleton (x:T) : multiset := cons (x,1) empty.
Check singleton.
(** TEST
  Eval compute in (singleton 2).
**)

(** add x n s ajoute, au multi-ensemble s, n occurrences de l’élément x dans s **)
Fixpoint add (x:T) (n:nat) (s:multiset) : multiset := if (le_lt_dec n 0) then s else
  match s with
  | nil => (x,n) :: empty
  | (x',occ) :: l' => (
    match (T_eq_dec x x') with
    | left _ => (x',occ+n) :: l'
    | right _ => (x',occ) :: (add x n l')
   end)
  end.
Check add.
(** TESTS
  Eval compute in (add 2 3 empty).
  Eval compute in (add 2 4 (add 2 5 empty)).
  Eval compute in (add 3 3 (singleton 2)).
**)

(** member x s retourne la valeur true si x a au moins une occurrence dans s,
    false sinon. **)
Fixpoint member (x:T) (s:multiset) : bool :=
  match s with
  | nil => false
  | (x',occ) :: l' => (
    match (T_eq_dec x x') with
    | left _ => true
    | right _ => member x l'
   end)
  end.
Check member.
(** TESTS
  Eval compute in (member 2 (add 2 3 empty)).
  Eval compute in (member 3 (add 2 5 empty)).
  Eval compute in (member 1 (singleton 2)).
  Eval compute in (member 1 empty).
**)

(** union fait l’union de deux multi-ensembles. **)
Fixpoint union (s1:multiset) (s2:multiset) : multiset :=
  match s1 with
  | nil => s2
  | (x',occ) :: l' => union l' (add x' occ s2)
  end.
Check union.
(** TESTS
  Eval compute in (union (add 2 3 empty) (add 2 4 empty)).
  Eval compute in (union (add 2 3 (add 4 5 empty)) (add 2 3 empty)).
  Eval compute in (union (add 2 3 empty) empty).
  Eval compute in (union empty empty).
**)

(** muliplicity x s retourne le nombre d’occurrences de x dans s **)
Fixpoint multiplicity (x:T) (s:multiset) : nat :=
  match s with
  | nil => 0
  | (x',occ) :: l' => (
    match (T_eq_dec x x') with
    | left _ => occ
    | right _ => multiplicity x l'
   end)
  end.
Check multiplicity.
(** TESTS
  Eval compute in (multiplicity 2 (add 2 7 empty)).
  Eval compute in (multiplicity 3 (add 2 7 empty)).
  Eval compute in (multiplicity 3 empty).
**)

(** removeOne x s retourne le multi-ensemble s avec une occurrence de moins
    pour x. Si s ne contient pas x, le multi-ensemble résultat est s. **)
Fixpoint removeOne (x:T) (s:multiset) : multiset :=
  match s with
  | nil => nil
  | (x', occ) :: l' => (
    match (T_eq_dec x x') with
    | left _ => (
      match (le_lt_dec occ 1) with
      | left _ => l'
      | right _ => (x', occ-1) :: l'
      end)
    | right _ => (x', occ) :: (removeOne x l')
   end)
  end.
Check removeOne.
(** TESTS
  Eval compute in (removeOne 2 (add 2 7 empty)).
  Eval compute in (removeOne 2 (add 2 2 (add 3 5 empty))).
  Eval compute in (removeOne 2 (add 6 5 (add 2 2 (add 3 5 empty)))).
  Eval compute in (removeOne 2 (add 2 1 (add 3 5 empty))).
  Eval compute in (removeOne 2 (add 6 5 (add 2 1 (add 3 5 empty)))).
  Eval compute in (removeOne 3 (add 2 7 empty)).
  Eval compute in (removeOne 3 empty).
**)

(** removeAll x s retourne le mult-ensemble s o`u x n’apparait plus.
    Si s ne contient pas x, le multiensemble r´esultat est s. **)
Fixpoint removeAll (x:T) (s:multiset) : multiset :=
  match s with
  | nil => nil
  | (x', occ) :: l' => (
    match (T_eq_dec x x') with
    | left _ => l'
    | right _ => (x', occ) :: removeAll x l'
   end)
  end.
Check removeAll.
(** TESTS
  Eval compute in (removeAll 2 (add 2 7 empty)).
  Eval compute in (removeAll 2 (add 2 2 (add 3 5 empty))).
  Eval compute in (removeAll 2 (add 6 5 (add 2 2 (add 3 5 empty)))).
  Eval compute in (removeAll 2 (add 2 1 (add 3 5 empty))).
  Eval compute in (removeAll 2 (add 6 5 (add 2 1 (add 3 5 empty)))).
  Eval compute in (removeAll 3 (add 2 7 empty)).
  Eval compute in (removeAll 3 empty).
**)

(****************)
(** Question 2 **)
(****************)

(********************)
(** Question 2. a) **)
(********************)

(** Ce prédicat spécifie qu’un élément appartient à un multi-ensemble dès lors
    qu’il en existe une occurrence **)
Inductive InMultiset (x:T) (l:multiset) : Prop :=
  | inMultiset_intro : member x l = true -> InMultiset x l.

(********************)
(** Question 2. b) **)
(********************)

(** Ce prédicat spécifie qu’une liste qui représente un multi-ensemble est bien
    formée, c'est-à-dire que tout élément de T apparaît dans au plus un seul couple
    et que tous les nombres d’occurrences sont des entiers naturels non nuls. **)
Inductive wf (l: multiset) : Prop :=
  | wf_intro : (forall x, (InMultiset x (removeAll x l) -> False) /\ (member x l = true -> (multiplicity x l) > 0)) -> wf l.

(********************)
(** Question 2. c) **)
(********************)

(** empty possède-t-elle un résultat bien formé ? **)
Theorem empty_wf : wf empty.
Proof.
  apply wf_intro. intro x. split; simpl ; intros H.
  + inversion H. discriminate H0.
  + discriminate H.
Qed.

(** singleton possède-t-elle un résultat bien formé ? **)
Theorem singleton_wf : forall (x:T), wf (singleton x).
Proof.
  intro x. apply wf_intro. intros x0. simpl.
  split.
  + case_eq (T_eq_dec x0 x).
    - intros e H H1. inversion H1. discriminate H0.
    - intros n H1 H2. inversion H2. simpl in H.
      case_eq (T_eq_dec x0 x).
      * intros e. contradiction.
      * intros H3 H4. rewrite H1 in H. discriminate H.
  + case_eq (T_eq_dec x0 x).
    - intros e H1 H2. omega.
    - intros n H1 H2. discriminate H2.
Qed.

(** Un preuve intermédiaire ... **)
Lemma plus_n_0 : forall n, n + O = n.
Proof.
induction n.
+ simpl. reflexivity.
+ simpl. rewrite IHn. reflexivity.
Qed.

(** Un preuve intermédiaire ... **)
Lemma wf_plus_n : forall t n0 n l, wf ((t, n0) :: l) -> wf ((t, n0+n) :: l).
Proof.
intros t n0 n l H.
induction n.
+ rewrite plus_n_0. assumption.
+ apply wf_intro. intros x. split.
  - simpl.
    case_eq(T_eq_dec x t).
    * intros e H1 H2. inversion H2. rewrite e in H0. inversion IHn. pose(H4:=H3 x).
      destruct H4. simpl in H4. rewrite H1 in H4. pose(H6:=H4 H2). destruct H6.
    * intros n1 H1 H2. inversion H2. simpl in H0. rewrite H1 in H0. inversion H.
      pose(H4:=H3 x). destruct H4. simpl in H4. rewrite H1 in H4.
      apply H4. apply inMultiset_intro. simpl. rewrite H1. exact H0.
  - intros H1. simpl in H1.
    case_eq(T_eq_dec x t).
    * intros e H2. simpl. rewrite H2. omega.
    * intros n1 H2. rewrite H2 in H1. simpl. rewrite H2. inversion H. pose(H3:=H0 x).
      destruct H3. simpl in H4. rewrite H2 in H4. rewrite H1 in H4. apply H4. reflexivity.
Qed.

(** Nous n'avons pas réussi à démontrer que add preserve les propriétés de
    bonne formation ... **)
Theorem add_wf : forall (x:T) (n:nat) (l: multiset), wf l -> wf (add x n l).
Proof.
intros x n l H. inversion H. pose(H1:=H0 x). destruct H1.
induction l ; simpl.
+ case_eq(le_lt_dec n 0).
  - intros l H3. assumption.
  - intros l H3. apply wf_intro. intros x0. split.
    * simpl.
      case_eq(T_eq_dec x0 x) ; intros e H4 H5 ; inversion H5 ; simpl in H6.
      ** discriminate H6.
      ** rewrite H4 in H6. discriminate H6.
    * simpl.
      case_eq(T_eq_dec x0 x).
      ** intros e H4. omega.
      ** intros n0 H4 H5. discriminate H5.
+ case_eq(le_lt_dec n 0) ;intros l0 H3.
  - assumption.
  - destruct a.
    case_eq(T_eq_dec x t).
    * intros e H4. apply wf_plus_n. assumption.
    * intros n1 H4. apply wf_intro. intros x0.
      split.
      ** intros H5. inversion H5. simpl in H6.
         case_eq(T_eq_dec x0 t).
         *** intros e H7.
             rewrite H7 in H6. rewrite e in H6. simpl in H2. rewrite H4 in H2. inversion H5.
Admitted.

(** Nous n'avons pas réussi à démontrer que union preserve les propriétés de
    bonne formation ... **)
Theorem union_wf : forall (l: multiset) (l': multiset), wf l -> wf l' -> wf (union l l').
Proof.
intros l l' well_formed_proof_of_l well_formed_proof_of_l'.
apply wf_intro.
intros x.
destruct well_formed_proof_of_l.
pose (H1 := H x).
destruct H1.
destruct well_formed_proof_of_l'.
pose (H3 := H2 x).
destruct H3.
split.
Admitted.

(** Nous n'avons pas réussi à démontrer que removeOne preserve les propriétés de
    bonne formation ... **)
Theorem removeOne_wf: forall (x: T) (l: multiset), wf l -> wf (removeOne x l).
Proof.
intros x l H.
induction l.
+ simpl. assumption.
+ destruct a. simpl.
  case_eq(T_eq_dec x t).
  - intros e H1.
    case_eq(le_lt_dec n 1).
    * intros l0 H2. apply wf_intro. intros x0.
      split.
      ** intros H3. inversion H.
Admitted.

(** Nous n'avons pas réussi à démontrer que removeAll preserve les propriétés de
    bonne formation ... **)
Theorem removeAll_wf: forall (x: T) (l: multiset), wf l -> wf (removeAll x l).
Proof.
intros x l H.
induction l.
+ simpl. assumption.
+ destruct a. simpl.
  case_eq(T_eq_dec x t).
  - intros e H1. inversion H.
    pose(H':=H0 x). destruct H'. apply wf_intro. intros x0. split.
Admitted.

(*****************)
(** Question 3. **)
(*****************)

Theorem proof_1_1 : forall (x : T), ~InMultiset x empty.
Proof.
 intros x. unfold not. intros H. inversion H. discriminate H0.
Qed.

Theorem proof_2_1 : forall x y , InMultiset y (singleton x) <-> x = y.
Proof.
 intros x y. unfold iff.
 split ; intros H.
 + inversion H. simpl in H0.
   case_eq (T_eq_dec y x).
   - intros e H2. rewrite e. reflexivity.
   - intros n H2. rewrite H2 in H0. discriminate H0.
 + apply inMultiset_intro. simpl.
   case_eq (T_eq_dec y x).
   - intros e H2. reflexivity.
   - intros n. symmetry in H. contradiction.
Qed.

Theorem proof_3_1 :forall x, multiplicity x (singleton x) = 1.
Proof.
 intros x. unfold singleton. simpl.
 destruct (T_eq_dec x x).
 + reflexivity.
 + contradiction.
Qed.

Theorem proof_4_1 : forall x s, wf s -> (member x s = true <-> InMultiset x s).
Proof.
intros x s well_formed_proof_of_l. unfold iff.
split ; intros H.
+ destruct well_formed_proof_of_l. pose (H1:=H0 x). destruct H1. apply inMultiset_intro. exact H.
+ inversion H. exact H0.
Qed.

Theorem proof_5_1 : forall x n s, n > 0 -> InMultiset x (add x n s).
Proof.
 intros x n s H. apply inMultiset_intro.
 induction s.
 + simpl.
   case_eq (le_lt_dec n 0) ; intros l H2.
   - apply (gt_not_le n 0) in H. contradiction.
   - simpl.
     destruct (T_eq_dec x x).
     * reflexivity.
     * unfold not in n0. destruct n0. reflexivity.
 + destruct a.
   case_eq (T_eq_dec t x).
   - intros e H1. rewrite e. simpl.
     case_eq (le_lt_dec n 0).
     * intros l. apply (gt_not_le n 0) in H. contradiction.
     * intros l H2. destruct (T_eq_dec x x) ; simpl.
       ** destruct (T_eq_dec x x).
          *** reflexivity.
          *** contradiction.
       ** destruct (T_eq_dec x x).
          *** reflexivity.
          *** exact IHs.
   - intros n1 H1. simpl.
     case_eq (le_lt_dec n 0).
     * intros l. apply (gt_not_le n 0) in H. contradiction.
     * intros l H2.
       case_eq (T_eq_dec x t).
       ** intros e. pose (f:=e). symmetry in f. contradiction.
       ** intros n2 H3. simpl.
          destruct (T_eq_dec x t).
          *** reflexivity.
          *** exact IHs.
Qed.

Theorem proof_6_1 : forall x n y s, x <> y -> (InMultiset y (add x n s) <-> InMultiset y s).
Proof.
 intros x n y s H. unfold iff.
 split.
 + intros H2. inversion H2. apply inMultiset_intro.
   induction s.
   - simpl. simpl in H0. case_eq (le_lt_dec n 0) ; intros l H1 ; rewrite H1 in H0 ; simpl in H0.
     * discriminate H0.
     * case_eq (T_eq_dec y x).
       ** intros e H3. pose(e':=e). symmetry in e'. contradiction.
       ** intros n0 H4. rewrite H4 in H0. discriminate H0.
   - destruct a.
     case_eq (T_eq_dec t y).
     * intros e H3. rewrite e. simpl.
       case_eq (T_eq_dec y y).
       ** reflexivity.
       ** contradiction.
     * intros n1 H3. simpl.
       case_eq (T_eq_dec y t).
       ** intros e. pose(e':=e). symmetry in e'. contradiction.
       ** intros n2 H4. simpl in H2.
          case_eq (le_lt_dec n 0); intros l H5 ; rewrite H5 in H2.
          *** inversion H2. simpl in H1. rewrite H4 in H1. assumption.
          *** case_eq (T_eq_dec x t).
              **** intros e H6. rewrite H6 in H2. rewrite e in H0. simpl in H0.
                   rewrite H5 in H0.
                   case_eq (T_eq_dec t t);intros e0 H7 ;rewrite H7 in H0; simpl in H0 ;rewrite H4 in H0.
                   ***** assumption.
                   ***** apply IHs.
                         ****** apply inMultiset_intro. rewrite e. exact H0.
                         ****** rewrite e. exact H0.
              **** intros n3 H6. rewrite H6 in H2. simpl in H0. rewrite H5 in H0.
                   rewrite H6 in H0. simpl in H0. rewrite H4 in H0. apply IHs.
                   ***** apply inMultiset_intro.
                         exact H0.
                   ***** exact H0.
 + intros H1. inversion H1. apply inMultiset_intro.
   induction s.
   - simpl.
     case_eq (le_lt_dec n 0) ; intros l H2.
     * exact H0.
     * simpl.
       case_eq (T_eq_dec y x).
       ** intros e H3. reflexivity.
       ** simpl in H0. discriminate H0.
   - destruct a.
     case_eq (T_eq_dec t x).
     * intros e H2. rewrite e. simpl.
       case_eq(le_lt_dec n 0).
       ** intros l H3. simpl.
          case_eq (T_eq_dec y x).
          *** intros e0. pose(e':=e0). symmetry in e'. contradiction.
          *** intros n1 H4. simpl in H0. case_eq (T_eq_dec y t).
              **** intros e0 H5. rewrite e0 in H. pose(e':=e). symmetry in e'. contradiction.
              **** intros n2 H5. rewrite H5 in H0. assumption.
       ** intros l H3.
          case_eq (T_eq_dec x x).
          *** intros e0 H4. simpl.
              case_eq(T_eq_dec y x).
              **** intros e1 H5. reflexivity.
              **** intros n1 H5. simpl in H0.
                   case_eq (T_eq_dec y t) ;  intros e1 H6.
                   ***** rewrite e1 in H. pose(e':=e). symmetry in e'. contradiction.
                   ***** rewrite H6 in H0. assumption.
          *** contradiction.
     * intros n1 H2. simpl.
       case_eq(le_lt_dec n 0) ; intros l H3.
       ** simpl.
          case_eq(T_eq_dec y t) ; intros e H4.
          *** reflexivity.
          *** simpl in H0. rewrite H4 in H0. assumption.
       ** case_eq(T_eq_dec x t) ; intros n2 H4 ; simpl.
          *** case_eq(T_eq_dec y t) ; intros e0 H5.
              **** reflexivity.
              **** simpl in H0. rewrite H5 in H0. assumption.
          *** case_eq(T_eq_dec y t).
              **** intros e H5. reflexivity.
              **** intros n3 H5. apply IHs.
                   apply inMultiset_intro.
                   ***** simpl in H0. rewrite H5 in H0. assumption.
                   ***** simpl in H0. rewrite H5 in H0. assumption.
Qed.

(** Un preuve intermédiaire ... **)
Lemma proof_7_1_1: forall x s, multiplicity x s <> 0 -> InMultiset x s.
Proof.
intros x s. intros H. apply inMultiset_intro.
induction s.
+ simpl in H. omega.
+ destruct a.
  case_eq (T_eq_dec x t) ; intros e H1.
  - rewrite e in H. simpl in H.
    case_eq (T_eq_dec t t).
    * intros e0 H2. rewrite e. simpl. rewrite H2. reflexivity.
    * intros n0. unfold not in n0. intros H2. rewrite e in H1. contradiction.
  - simpl. rewrite H1. simpl in H. rewrite H1 in H. apply IHs. assumption.
Qed.

Theorem proof_7_1_2 : forall x s, wf s -> (multiplicity x s = 0 <-> ~InMultiset x s).
Proof.
intros x s well_formed_proof_of_l. unfold iff.
split.
+ unfold not. intros H1 H2. destruct H2. destruct well_formed_proof_of_l.
  pose (H2:= H0 x). destruct H2. apply H3 in H. rewrite H1 in H. omega.
+ intros H2. unfold not in H2. destruct well_formed_proof_of_l. pose (H3:= H x). destruct H3.
  case_eq (Nat.eq_dec (multiplicity x s) 0) ; intros e H3.
  - exact e.
  - pose (n':=e). apply proof_7_1_1 in n'. pose (H4:=H2 n'). destruct H2.
Qed.

Theorem proof_8_1 : forall x n s, multiplicity x (add x n s) = n + (multiplicity x s).
Proof.
intros x n s.
induction s.
+ simpl.
  case_eq(le_lt_dec n 0) ; intros l H1 ; simpl.
  - omega.
  - case_eq(T_eq_dec x x).
    * intros e H2. omega.
    * contradiction.
+ destruct a.
  case_eq (T_eq_dec x t) ; intros e H1.
  - rewrite e. simpl.
    case_eq (le_lt_dec n 0) ;intros l H2.
    * simpl. omega.
    * case_eq (T_eq_dec t t).
      ** intros e0 H3. simpl. rewrite H3. omega.
      ** contradiction.
  - simpl.
    case_eq (le_lt_dec n 0) ; intros l H2.
    * simpl. omega.
    * rewrite H1. simpl. rewrite H1. assumption.
Qed.

(** Nous n'avons pas réussi à démontrer cette preuve ... **)
Theorem proof_9_1 : forall x n y s, x <> y -> wf s ->multiplicity y (add x n s) = multiplicity y s.
Proof.
intros x n y s H H2. inversion H2. pose(H':=H0 x). destruct H'.
induction s.
+ simpl.
  case_eq (le_lt_dec n 0) ; intros l H4 ; simpl.
  - reflexivity.
  - case_eq(T_eq_dec y x).
    * intros e. pose(e':=e). symmetry in e'. contradiction.
    * intros n0 H5. reflexivity.
+ destruct a. simpl.
  case_eq(le_lt_dec n 0).
  - intros l H4. simpl. omega.
  - intros l H4.
    case_eq(T_eq_dec x t) ; intros e H5 ; simpl.
    * case_eq(T_eq_dec y t).
      ** intros e0. rewrite e0 in H. contradiction.
      ** intros n1 H6. reflexivity.
    * case_eq(T_eq_dec y t).
      ** reflexivity.
      ** intros n2 H6. apply IHs. apply wf_intro. intros x0.
         split. simpl in H1. rewrite H5 in H1. intros H7. inversion H7.
Admitted.

(** Nous n'avons pas réussi à démontrer cette preuve ... **)
Theorem proof_10_1 : forall s t x, wf s -> wf t ->(InMultiset x (union s t) <-> InMultiset x s \/ InMultiset x t).
Proof.
intros s t x H1 H2. pose(H':=union_wf s t H1 H2). unfold iff.
split.
+ intros H3. inversion H3. inversion H1. pose (H4:=H0 x). destruct H4.
Admitted.

(*****************)
(** Question 4. **)
(*****************)

Theorem proof_11_1 : forall x, multiplicity x (removeOne x (singleton x)) = 0.
Proof.
intros x. simpl.
case_eq(T_eq_dec x x ).
+ intros e H. simpl. reflexivity.
+ contradiction.
Qed.

Theorem proof_12_1 : forall x, multiplicity x (removeAll x (singleton x)) = 0.
Proof.
intros x. simpl.
case_eq(T_eq_dec x x ).
+ intros e H. simpl. reflexivity.
+ contradiction.
Qed.

Theorem proof_13_1 : forall x l n, multiplicity x l = n -> n > 1 -> multiplicity x (removeOne x l) = n-1.
Proof.
intros x l n H1 H2.
induction l.
+ simpl. simpl in H1. omega.
+ destruct a. simpl.
  case_eq(T_eq_dec x t) ;intros e H3.
  - case_eq(le_lt_dec n0 1) ; intros l0 H4.
    * rewrite e in H1. simpl in H1.
      case_eq (T_eq_dec t t).
      ** intros e0 H5. rewrite H5 in H1. omega.
      ** contradiction.
    *  simpl. rewrite H3. rewrite e in H1. simpl in H1.
      case_eq(T_eq_dec t t).
      ** intros e0 H5. rewrite H5 in H1. rewrite H1. reflexivity.
      ** contradiction.
  - simpl. rewrite H3. apply IHl. simpl in H1. rewrite H3 in H1. assumption.
Qed.

Theorem proof_14_1 : forall x l, wf l -> ~(InMultiset x (removeAll x l)).
Proof.
intros x l H1. unfold not. intros H2. inversion H2. inversion H1.
pose(H':=H0 x). destruct H'. pose(H5:=H3 H2). destruct H5.
Qed.

Theorem proof_15_1 : forall x l, multiplicity x l > 1 -> InMultiset x (removeOne x l).
Proof.
intros x l H1. apply inMultiset_intro.
induction l.
+ simpl in H1. omega.
+ destruct a. simpl.
  case_eq(T_eq_dec x t) ;intros e H3.
  - case_eq(le_lt_dec n 1) ; intros l0 H4.
    * rewrite e in H1. simpl in H1.
      case_eq (T_eq_dec t t).
      ** intros e0 H5. rewrite H5 in H1. omega.
      ** contradiction.
    * simpl. rewrite H3. reflexivity.
  - simpl. rewrite H3. apply IHl. simpl in H1. rewrite H3 in H1. assumption.
Qed.

(******************************************************************************)
(**************2.2 Implantation Fonctionnelle des multi-ensembles**************)
(******************************************************************************)
(****** PREUVES RÉUSSIES : 16 *************************************************)
(****** PREUVES ADMISES :   0 *************************************************)
(******************************************************************************)

(****************)
(** Question 1 **)
(****************)

Definition multiset_2 := T -> nat.
Print multiset_2.

(** empty_2 est le multiset vide. **)
Definition empty_2 : multiset_2 := (fun a:T => 0).
Check empty_2.
(** TEST
  Eval compute in empty_2.
**)

(** singleton_2 x crée le multi-ensemble qui ne contient que x en un seul exemplaire **)
Definition singleton_2 (x:T) : multiset_2 := fun a:T =>
  match T_eq_dec a x with
  | left _ => 1
  | right _ => 0
  end.
Check singleton_2.
(** TEST
  Eval compute in ((singleton_2 2) 3).
  Eval compute in ((singleton_2 2) 2).
**)

(** add_2 x n s ajoute, au multi-ensemble s, n occurrences de l’élément x dans s **)
Definition add_2 (x:T) (n:nat) (s:multiset_2) : multiset_2 := fun a:T =>
  match T_eq_dec a x with
  | left _ => s x + n
  | right _ => s a
  end.
Check add_2.
(** TEST
  Eval compute in ((add_2 3 4 (add_2 2 3 (singleton_2 1))) 3).
  Eval compute in ((add_2 3 4 (add_2 2 3 (singleton_2 1))) 3).
  Eval compute in ((add_2 3 4 (add_2 2 3 (singleton_2 1))) 5).
  Eval compute in ((add_2 3 4 (add_2 2 3 (empty_2))) 1).
**)

(** member_2 x s retourne la valeur true si x a au moins une occurrence dans s,
    false sinon. **)
Definition member_2 (x:T) (s:multiset_2) : bool :=
  match Nat.eq_dec (s x) 0 with
  | left _ => false
  | right _ => true
  end.
Check member_2.
(** TESTS
  Eval compute in (member_2 2 (empty_2)).
  Eval compute in (member_2 2 (singleton_2 2)).
  Eval compute in (member_2 3 (singleton_2 2)).
  Eval compute in (member_2 3 (add_2 3 0 empty_2)).
  Eval compute in (member_2 3 (add_2 3 1 empty_2)).
**)

(** union_2 fait l’union de deux multi-ensembles. **)
Definition union_2 (s1:multiset_2) (s2:multiset_2) : multiset_2 := (fun a:T => s1 a + s2 a).
Check union_2.
(** TESTS
  Eval compute in ((union_2 (add_2 2 3 empty_2) (add_2 2 4 empty_2)) 2).
  Eval compute in ((union_2 (add_2 2 3 (add_2 4 5 empty_2)) (add_2 2 3 empty_2)) 4).
  Eval compute in ((union_2 (add_2 2 3 empty_2) empty_2) 2).
  Eval compute in ((union_2 empty_2 empty_2) 1).
**)

(** multiplicity_2 x s retourne le nombre d’occurrences de x dans s **)
Definition multiplicity_2 (x:T) (s:multiset_2) : nat := s x.
Check multiplicity_2.
(** TESTS
  Eval compute in (multiplicity_2 2 (add_2 2 7 empty_2)).
  Eval compute in (multiplicity_2 3 (add_2 2 7 empty_2)).
  Eval compute in (multiplicity_2 3 empty_2).
**)

(** removeOne_2 x s retourne le multi-ensemble s avec une occurrence de moins pour x.
    Si s ne contient pas  x, le multi-ensemble résultat est s. **)
Definition removeOne_2 (x:T) (s:multiset_2) : multiset_2 := fun a:T =>
  match T_eq_dec a x with
  | left _ => if member_2 x s then s x - 1 else 0
  | right _ => s a
  end.
Check removeOne_2.
(** TESTS
  Eval compute in ((removeOne_2 2 (add_2 2 7 empty_2)) 2).
  Eval compute in ((removeOne_2 2 (add_2 2 2 (add_2 3 5 empty_2))) 2).
  Eval compute in ((removeOne_2 2 (add_2 6 5 (add_2 2 2 (add_2 3 5 empty_2)))) 2).
  Eval compute in ((removeOne_2 2 (add_2 2 1 (add_2 3 5 empty_2))) 2).
  Eval compute in ((removeOne_2 2 (add_2 6 5 (add_2 2 1 (add_2 3 5 empty_2)))) 2).
  Eval compute in ((removeOne_2 3 (add_2 2 7 empty_2)) 3).
  Eval compute in ((removeOne_2 3 empty_2) 3).
**)

(** removeAll_2 x s retourne le mult-ensemble s o`u x n’apparait plus.
    Si s ne contient pas x, le multiensemble r´esultat est s. **)
Definition removeAll_2 (x:T) (s:multiset_2) : multiset_2 := fun a:T =>
  match T_eq_dec a x with
  | left _ => 0
  | right _ => s a
  end.
Check removeAll_2.
(** TESTS
  Eval compute in ((removeAll_2 2 (add_2 2 7 empty_2)) 2).
  Eval compute in ((removeAll_2 2 (add_2 2 2 (add_2 3 5 empty_2))) 2).
  Eval compute in ((removeAll_2 2 (add_2 6 5 (add_2 2 2 (add_2 3 5 empty_2)))) 2).
  Eval compute in ((removeAll_2 2 (add_2 2 1 (add_2 3 5 empty_2))) 2).
  Eval compute in ((removeAll_2 2 (add_2 6 5 (add_2 2 1 (add_2 3 5 empty_2)))) 2).
  Eval compute in ((removeAll_2 3 (add_2 2 7 empty_2)) 2).
  Eval compute in ((removeAll_2 3 empty_2) 3).
**)

(****************)
(** Question 2 **)
(****************)

(** Ce prédicat spécifie qu’un élément appartient à un multi-ensemble dès lors
    qu’il en existe une occurrence **)
Inductive InMultiset_2 (x:T) (l:multiset_2) : Prop :=
  | inMultiset_2_intro : member_2 x l = true -> InMultiset_2 x l.

(****************)
(** Question 3 **)
(****************)

Theorem proof_1_2 : forall (x : T), ~InMultiset_2 x empty_2.
Proof.
 intros x. unfold not. intros H. inversion H. discriminate H0.
Qed.

Theorem proof_2_2 : forall x y , InMultiset_2 y (singleton_2 x) <-> x = y.
Proof.
 intros x y. unfold iff.
 split.
 + intros H. inversion H. unfold member_2 in H0. unfold singleton_2 in H0.
   case_eq (T_eq_dec y x) ; intros H1 H2.
   - rewrite H1 in H0. destruct H0. symmetry. assumption.
   - rewrite H2 in H0. simpl in H0. discriminate H0.
 + intros H0. apply inMultiset_2_intro. unfold member_2. unfold singleton_2. rewrite H0.
   destruct (T_eq_dec y y).
   - destruct (Nat.eq_dec 1 0). discriminate e0. reflexivity.
   - destruct (Nat.eq_dec 0 0). contradiction. reflexivity.
Qed.

Theorem proof_3_2 :forall x, multiplicity_2 x (singleton_2 x) = 1.
Proof.
 intros x. unfold multiplicity_2. unfold singleton_2.
 case_eq (T_eq_dec x x).
 + reflexivity.
 + intros n H. contradiction.
Qed.

Theorem proof_4_2 : forall x s, member_2 x s = true <-> InMultiset_2 x s.
Proof.
intros x s. unfold iff.
split ; intros H.
+ apply inMultiset_2_intro. exact H.
+ inversion H. exact H0.
Qed.

Theorem proof_5_2 : forall x n s, n > 0 -> InMultiset_2 x (add_2 x n s).
Proof.
intros x n s H. apply inMultiset_2_intro. unfold member_2. unfold add_2.
case_eq (T_eq_dec x x) ; intros e H1.
+ case_eq (Nat.eq_dec (s x + n) 0).
  - intros e0 H2. omega.
  - reflexivity.
+ contradiction e. reflexivity.
Qed.

Theorem proof_6_2 : forall x n y s, x <> y -> (InMultiset_2 y (add_2 x n s) <-> InMultiset_2 y s).
Proof.
 intros x n y s H. unfold iff.
 split ; intros H1 ; inversion H1.
 + apply inMultiset_2_intro.  unfold member_2. unfold member_2 in H0.
   case_eq (Nat.eq_dec (s y) 0).
   - intros e H3. unfold add_2 in H0.
     case_eq (T_eq_dec y x).
     * intros e0. pose(e0':=e0).  symmetry in e0'. contradiction.
     * intros n0 H4. rewrite H4 in H0. rewrite e in H0. simpl in H0. discriminate H0.
   - intros n0 H3. reflexivity.
 + unfold member_2 in H0. apply inMultiset_2_intro. unfold member_2. unfold add_2.
     case_eq (T_eq_dec y x ) ; intros e H2.
   - pose(e0':=e). symmetry in e0'. contradiction.
   - exact H0.
Qed.

Lemma proof_7_2_1: forall x s, s x <> 0 -> InMultiset_2 x s.
Proof.
intros x s H. apply inMultiset_2_intro. unfold member_2.
case_eq (Nat.eq_dec (s x) 0) ; intros e H1.
+ contradiction.
+ reflexivity.
Qed.

Theorem proof_7_2_2 : forall x s, multiplicity_2 x s = 0 <-> ~InMultiset_2 x s.
Proof.
 intros x s. unfold iff.
 split.
 + intros H. unfold multiplicity_2 in H. unfold not. intros H2. inversion H2.
   unfold member_2 in H0. rewrite H in H0. simpl in H0. discriminate H0.
 + unfold not. intros H. unfold multiplicity_2.
   case_eq (Nat.eq_dec (s x) 0) ; intros e H1.
   - exact e.
   - pose (n':=e). apply proof_7_2_1 in n'. pose (H2:=H n'). destruct H2.
Qed.

Theorem proof_8_2 : forall x n s, multiplicity_2 x (add_2 x n s) = n + (multiplicity_2 x s).
Proof.
intros x n s. unfold multiplicity_2. unfold add_2.
destruct (T_eq_dec x x).
+ omega.
+ contradiction.
Qed.

Theorem proof_9_2 : forall x n y s, x <> y -> multiplicity_2 y (add_2 x n s) = multiplicity_2 y s.
Proof.
intros x n y s H. unfold multiplicity_2. unfold add_2.
destruct (T_eq_dec y x).
+ pose(e0':=e). symmetry in e0'. contradiction.
+ reflexivity.
Qed.

Theorem proof_10_2 : forall s t x, (InMultiset_2 x (union_2 s t) <-> InMultiset_2 x s \/ InMultiset_2 x t).
Proof.
 intros s t x. unfold iff.
 split.
 + intros H. inversion H. unfold member_2 in H0. unfold union_2 in H0.
   case_eq (Nat.eq_dec (s x) 0).
   - intros e H1. right. rewrite e in H0. simpl in H0.
     case_eq (Nat.eq_dec (t x) 0) ;intros e0 H2.
     * rewrite H2 in H0. discriminate H0.
     * apply inMultiset_2_intro. unfold member_2. rewrite H2. reflexivity.
   - case_eq (Nat.eq_dec (s x + t x) 0) ;intros e H1 ;rewrite H1 in H0.
     * discriminate H0.
     * intros n0 H2. left. apply inMultiset_2_intro. unfold member_2. rewrite H2. reflexivity.
 + intros H. destruct H ; inversion H ; unfold member_2 in H0 ;
   apply inMultiset_2_intro ; unfold member_2 ; unfold union_2.
   - case_eq (Nat.eq_dec (s x) 0) ;intros n H1.
     * rewrite n in H0. simpl in H0.  discriminate H0.
     * case_eq (Nat.eq_dec (s x + t x) 0).
       ** intros e. omega.
       ** intros n0 H2. reflexivity.
   - case_eq (Nat.eq_dec (t x) 0) ; intros n H1.
     * rewrite n in H0. simpl in H0. discriminate H0.
     * case_eq (Nat.eq_dec (s x + t x) 0).
       ** intros e. omega.
       ** intros n0 H2. reflexivity.
Qed.

Theorem proof_11_2 : forall x, multiplicity_2 x (removeOne_2 x (singleton_2 x)) = 0.
Proof.
intros x. unfold multiplicity_2. unfold removeOne_2.
case_eq(T_eq_dec x x).
+ intros H. unfold member_2.
  case_eq(Nat.eq_dec (singleton_2 x x) 0) ; intros n H1.
  - reflexivity.
  - unfold singleton_2 in n. unfold singleton_2.
    case_eq(T_eq_dec x x).
    * intros e H2. omega.
    * contradiction.
+ contradiction.
Qed.

Theorem proof_12_2 : forall x, multiplicity_2 x (removeAll_2 x (singleton_2 x)) = 0.
Proof.
intros x. unfold multiplicity_2. unfold removeAll_2.
destruct (T_eq_dec x x).
+ reflexivity.
+ contradiction.
Qed.

Theorem proof_13_2 : forall x l n, multiplicity_2 x l = n -> n > 1 -> multiplicity_2 x (removeOne_2 x l) = n-1.
Proof.
intros x l n H1 H2. unfold multiplicity_2. unfold removeOne_2.
destruct (T_eq_dec x x).
+ unfold member_2.
  case_eq(Nat.eq_dec (l x) 0) ; intros e0 H3 ;unfold multiplicity_2 in H1.
  - rewrite e0 in H1. omega.
  - rewrite H1. reflexivity.
+ contradiction.
Qed.

Theorem proof_14_2 : forall x l, ~(InMultiset_2 x (removeAll_2 x l)).
Proof.
intros x l. unfold not. intros H. inversion H. unfold member_2 in H0.
case_eq(Nat.eq_dec (removeAll_2 x l x) 0) ; intros n H1.
+ rewrite H1 in H0. discriminate H0.
+ unfold removeAll_2 in n.
  case_eq(T_eq_dec x x).
  - intros e H2. pose(n':=n). rewrite H2 in n'. contradiction.
  - contradiction.
Qed.

Theorem proof_15_2 : forall x l, multiplicity_2 x l > 1 -> InMultiset_2 x (removeOne_2 x l).
Proof.
intros x l H. apply inMultiset_2_intro. unfold member_2. unfold removeOne_2.
case_eq(T_eq_dec x x).
+ intros e H1. unfold member_2.
  case(Nat.eq_dec (l x) 0) ; intros H2.
  - unfold multiplicity_2 in H. rewrite H2 in H. omega.
  - case_eq(Nat.eq_dec (l x - 1) 0) ; intros e0 H3.
    * unfold multiplicity_2 in H. omega.
    * reflexivity.
+ contradiction.
Qed.


From LF Require Export Induction.

Module NatList.

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

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

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

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

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

Example fst_test: (fst (3, 5)) = 3.
Proof. simpl. reflexivity. Qed.

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

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

(******************************************************************************)

(* Exercise *)

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

(* Exercise *)

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

(******************************************************************************)

(* To introduce the concept of a list, one may generalize the idea of pairs in
 * which a list is either the empty list or a pair of an element with another
 * list (which could be empty, of course).
 *)

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

(* A list with 3 elements: *)
Definition my_list := cons 1 (cons 2 (cons 3 nil)).

(* Lower `level`s bind tighter. *)
Notation "x :: l" := (cons x l) (at level 60, right associativity).
Notation "[]" := nil.
Notation "[ x ; .. ; y ]" := (cons x .. (cons y nil) ..).

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

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

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

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

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

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

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

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

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

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

Fixpoint oddmembers (l : natlist) : natlist :=
  match l with
  | [] => []
  | h :: t => if odd h
                then h :: oddmembers t
                else oddmembers t
  end.

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

Definition countoddmembers (l : natlist) : nat :=
  length (oddmembers l).

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

(******************************************************************************)

(* Exercise *)

Fixpoint alternate (l1 l2 : natlist) : natlist :=
  match l1, l2 with
  | [], l2 => l2
  | l1, [] => l1
  | h1 :: t1, h2 :: t2 => h1 :: h2 :: alternate t1 t2
  end.

(******************************************************************************)

Definition bag := natlist.

Fixpoint count (v : nat) (s : bag) : nat :=
  match s with
  | [] => 0
  | h :: t => let r := count v t in
                if h =? v then 1 + r else r
  end.

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

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

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

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

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

Definition member (v : nat) (s : bag) : bool :=
  negb (count v s =? 0).

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

Fixpoint member' (v : nat) (s : bag) : bool :=
  match s with
  | [] => false
  | h :: t => if h =? v then true else member' v t
  end.

Example test_member'1: member' 1 [1; 4; 1] = true.
Proof. reflexivity. Qed.
Example test_member'2: member' 2 [1; 4; 1] = false.
Proof. reflexivity. Qed.

(******************************************************************************)

(* Exercises *)

Fixpoint remove_one (v : nat) (s : bag) : bag :=
  match s with
  | [] => []
  | h :: t => if h =? v
                then t
                else (h :: remove_one v t)
  end.

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

Fixpoint remove_all (v : nat) (s : bag) : bag :=
  match s with
  | [] => []
  | h :: t => let r := remove_all v t in
                if h =? v then r else h :: r
  end.

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

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

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

(******************************************************************************)

(* Exercise *)

Theorem bag_add_theorem : forall (v : nat) (b : bag),
  count v (add v b) = S (count v b).
Proof.
  intros v b.
  simpl.
  rewrite eqb_refl.
  reflexivity.
Qed.

(******************************************************************************)

(* Example of a proof on a list that can be solved using just simplification. *)
Theorem nil_app : forall l : natlist,
  [] ++ l = l.
Proof. simpl. reflexivity. Qed.

(* Simplification was enough since `[]` was present in one of the app's pattern
 * match branches.
 *)

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

(* Most interesting proofs on lists, however, can only be solved using
 * induction, just like with natural numbers.
 *)

(* Using induction to prove facts about lists is pretty much the same as that of
 * numbers.
 *
 * Inductively defined types declare a set of constructors, which are used to
 * build a value of such type. Notice that, if one applies some constructor to a
 * value of that constructor's type, one then has an inductively defined type.
 *
 * This fact raises a new way of thinking about inductively defined types. In
 * the cases where the constructor is applied to another value of such type,
 * the “inner” value can always be thought as of a “smaller” value if compared
 * to the “outer” value.
 *
 * For example, in the list `cons 1 (cons 2 nil)`, the “inner” list,
 * `cons 2 nil` is smaller than the “outer” list.
 *
 * Hence, wanting to prove some proposition `P` for all lists using induction,
 * one must:
 *
 *   - Show that `P` is valid for `nil`;
 *   - Show that `P` is valid for `cons n l'`, assuming that `P` holds for the
 *     smaller list `l'`.
 *)

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

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

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

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

Theorem rev_length : forall l : natlist,
  length (rev l) = length l.
Proof.
  intros l.
  induction l as [| n l' IHl'].
  - reflexivity.
  - simpl.
    (* `rev l` is itself a list, so we are able to use the above lemma. *)
    rewrite -> app_length.
    simpl. rewrite -> IHl'.
    rewrite add_comm. reflexivity.
Qed.

(******************************************************************************)

(* Exercises *)

Theorem app_nil_r : forall l : natlist,
  l ++ [] = l.
Proof.
  intros l.
  (* Since the definition of `app` pattern matches the first operator, this
   * cannot be trivially proven using simplification. *)
  induction l as [| n l' IHl'].
  - reflexivity.
  - simpl. rewrite IHl'. reflexivity.
Qed.

Theorem rev_app_distr: forall l1 l2 : natlist,
  rev (l1 ++ l2) = rev l2 ++ rev l1.
Proof.
  intros l1 l2.
  (* `l1` in `app` is arbitrary, so induction is one's last resort after
   * unsuccessful simplification or case analysis. *)
  induction l1 as [| n l1' IHl1'].
  - simpl. rewrite app_nil_r. reflexivity.
  - simpl. rewrite IHl1'. rewrite app_assoc. reflexivity.
Qed.

Theorem rev_involutive : forall l : natlist,
  rev (rev l) = l.
Proof.
  intros l.
  induction l as [| n l' IHl'].
    (* The definition or `rev` for `[]` is trivial. *)
  - reflexivity.
  - simpl. rewrite rev_app_distr.
    (* Step by step of `rev [n]` simplification, just to be explicit. *)
    simpl rev. simpl app.
    rewrite -> IHl'.
    reflexivity.
Qed.

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

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

(******************************************************************************)

(* Exercises *)

Fixpoint eqblist (l1 l2 : natlist) : bool :=
  match l1, l2 with
  | [], []             => true
  | h1 :: t1, h2 :: t2 => (h1 =? h2) && eqblist t1 t2
  | _, _               => false
  end.

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

Theorem eqblist_refl : forall (l : natlist),
  true = eqblist l l.
Proof.
  intros l.
  (* Since `l` is arbitrary, one must use induction. *)
  induction l as [| n l' IHl'].
  - reflexivity.
  - simpl. rewrite <- IHl'. rewrite eqb_refl. reflexivity.
Qed.

(******************************************************************************)

(* Exercises *)

Theorem count_member_nonzero: forall s : bag,
  1 <=? (count 1 (1 :: s)) = true.
Proof.
intros s. induction s as [|h t IHs'].
- reflexivity.
- simpl count. simpl leb. reflexivity.
Qed.

Theorem leb_n_Sn : forall n : nat,
  n <=? S n = true.
Proof.
  intros n.
  (* `n` is arbitrary, `leb` can't *)
  induction n as [| n' IHn'].
    (* `0 <=? 1` has a match arm, `O, n => true`. *)
  - reflexivity.
  - simpl. rewrite IHn'. reflexivity.
Qed.

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

(******************************************************************************)

(* Exercise *)

(* Write down an interesting theorem bag_count_sum about bags involving the
 * functions count and sum, and prove it using Coq. (You may find that the
 * difficulty of the proof depends on how you defined count! Hint: If you
 * defined count using =? you may find it useful to know that destruct works on
 * arbitrary expressions, not just simple identifiers.
 *)

Theorem bag_count_sum : forall (x : nat) (b1 b2 : bag),
  count x (sum b1 b2) = count x b1 + count x b2.
Proof.
  intros x b1 b2.
  induction b1 as [| n b1' IHb1'].
  - reflexivity.
  - simpl.
    (* Destruct `n =? x` for all constructors of `bool` (which is the type of
     * that expression. *)
    destruct (n =? x) eqn:E.
    + rewrite IHb1'. reflexivity.
    + rewrite IHb1'. reflexivity.
Qed.

(******************************************************************************)

(* Exercise *)

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

(******************************************************************************)

(*
 * OPTIONS
 *)

(* This is bad since the caller must always provide a default value. *)
Fixpoint nth_bad (default : nat) (l : natlist) (n : nat) : nat :=
  match l with
  | [] => default
  | h :: t => match n with
              | 0 => h
              | S n' => nth_bad default t n'
              end
  end.

(* Another option is to use some type to encode the absence of a value. *)
Inductive natoption : Type :=
  | None
  | Some (n : nat).

Fixpoint nth_error (l : natlist) (n : nat) : natoption :=
  match l with
  | [] => None
  | h :: t => match n with
              | 0 => Some h
              | S n' => nth_error t n'
              end
  end.

Example test_nth_error1: nth_error [4; 5; 6; 7] 0 = Some 4.
Proof. reflexivity. Qed.
Example test_nth_error2: nth_error [4; 5; 6; 7] 3 = Some 7.
Proof. reflexivity. Qed.
Example test_nth_error3: nth_error [4; 5; 6; 7] 9 = None.
Proof. reflexivity. Qed.

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

(******************************************************************************)

(* Exercise *)

Definition hd_error (l : natlist) : natoption :=
  match l with
  | [] => None
  | h :: t => Some h
  end.

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

(******************************************************************************)

(* Exercise *)

Theorem option_elim_hd : forall (l : natlist) (default : nat),
  hd default l = option_elim default (hd_error l).
Proof.
  intros l d.
  destruct l as [| h l'].
  - reflexivity.
  - reflexivity.
Qed.

End NatList.

(******************************************************************************)

(*
 * PARTIAL MAPS
 *)

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

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

Theorem eqb_id_refl : forall (x : id),
  eqb_id x x = true.
Proof.
  intros x.
  destruct x as [n].
  simpl.
  rewrite eqb_refl.
  reflexivity.
Qed.

Module PartialMap.

Export NatList.

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

(* The `update` function overrides the entry for a given key by shadowing it
 * with a new one, or simply adds a new entry “at the top”. *)
Definition update
  (d : partial_map) (x : id) (value : nat) : partial_map :=
    record x value d.

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

(******************************************************************************)

(* Exercise *)

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

(******************************************************************************)

(* Exercise *)

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

End PartialMap.