(*
Inductive bool : Type :=
| true : bool
| false : bool
.
*)

(*
 true -> 100
 false -> true
*)

Definition btype
  (b: bool) : Type :=
  match b with
  | true => nat
  | false => bool
  end.

Check btype.

Compute (btype true).

Compute (btype false).

(*
Definition foo (b: bool)
  : btype b
:=
  match b with
  | true => 100
  | false => true
  end.
*)

(*
e1 : Type
e2 : Type
=========
forall (x:e1), e2 : Type
*)

(* foo: bool -> nat + bool *)

(* foo: forall (b: bool), btype b *)

(*   forall (n: nat), vector n *)

(*   nat -> list *)

(*
Definition foo: forall (b: bool), btype b
:=
  fun b: bool =>
  match b with
  | true => 100
  | false => true
  end.
*)

Definition foo (b: bool)
  : btype b
:=
  match b with
  | true => 100
  | false => true
  end.

Check foo.

Compute foo true.
Compute foo false.

Check foo.

Check btype.

Definition bar (b: bool)
  : Type
:=
  match b with
  | true => nat
  | false => bool
  end.

(*
forall b : bool, btype b

forall b : bool, Type
*)

(*
   9 Feb 2017
 *)

(*
Inductive TrueT : Type :=
| TT : TrueT
.

Inductive FalseT: Type :=
.

Definition istrue (b: bool) : Type :=
  match b with
  | true => TrueT
  | false => FalseT
  end.

Compute istrue true .

Compute istrue false.

Check (TT: istrue true).

Definition true_is_true : istrue true
:= TT.

(* Definition false_is_true : istrue false := ???. *)

Definition false_is_not_true :
 istrue false -> FalseT
:=
  fun x : istrue false =>
    match x with
    end : FalseT
.

(*
  P -> Q     P
  ------------
       Q

  e: P -> Q          e1 : P
 --------------------------
   e e1 : Q
*)

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

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

Definition two_plus_even_is_even :
  forall n:nat, istrue (evenb n) -> istrue (evenb (2 + n))
:=
  fun n:nat => fun pf: istrue (evenb n) => pf.

Definition even_plus_two_is_even :
  forall n:nat, istrue (evenb n) -> istrue (evenb (n+2))
  :=
  fix even_plus_two_is_even n :=
    match n return istrue (evenb n) -> istrue (evenb (n+2)) with
    | 0 => fun x => x
    | 1 => fun x => x
    | S (S m) => fun x => even_plus_two_is_even m x
    end.

Inductive even: nat -> Type :=
| zero_is_even : even 0
| succ_succ_even (n: nat) (pf: even n) : even (S (S n))
.

Check even.

Check (even: nat -> Type).

(*
* zero_is_even : even 0

* succ_succ_even 0 zero_is_even : even (S (S 0))

* succ_succ_even (S(S 0)) (succ_succ_even 0 zero_is_even) : even (S (S (S (S 0)))
*)

(*
Definition even' (n: nat) : Type :=
  exists m, n = 2 * m.
*)

(*
  e : vector (1 + n)    e: vector (S(n))

    e : T  S===T
   -------------
       e : S
*)

Definition two_plus_even_is_even' :
  forall n:nat, even n -> even (2+n)
  :=
  fun n:nat => fun pf: even n => succ_succ_even n (pf).

Definition even_plus_two_is_even' :
  forall n:nat, even n -> even (n+2)
  :=
  fix even_plus_two_is_even n :=
    match n return even n -> even (n+2) with
    | 0 | 1 => fun x => succ_succ_even _ x
    | S (S m) => fun pf : even (S (S m)) =>
      succ_succ_even (m+2) (
      even_plus_two_is_even m
      match pf in even k
        return match k with 0 | 1 => TrueT | S(S l) => even l end
      with
      | zero_is_even => TT
      | succ_succ_even m pf => pf
      end)
    end.

(* Compute (even_plus_two_is_even' 0 zero_is_even). *)

Definition even_plus_two_is_even'':
  forall n:nat, even n -> even (n+2).
Proof.
  fix 1.
  intros. destruct n.
  - simpl. apply succ_succ_even.
    assumption.
  - destruct n.
    + apply succ_succ_even.
      assumption.
    + inversion H. subst. simpl.
      apply succ_succ_even.
      apply even_plus_two_is_even''.
      assumption.
Defined.

Compute (even_plus_two_is_even'' 0 zero_is_even).

Definition induction_for_nat:
forall P : nat -> Type,
  P 0 ->
  (forall n : nat, P n -> P (S n)) ->
forall n : nat, P n
:=
  fun P => fun (base: P 0) =>
  fun (step: forall n : nat, P n -> P (S n)) =>
  fix ind n :=
    match n return P n with
    | 0 => base
    | S m => step m (ind m)
    end.

Inductive EqT (A: Type) : A -> A -> Type :=
| eqrefl (x: A) : EqT A x x
.

Check eqrefl.

Definition succ_is_not_0:
  forall n: nat, EqT nat (S n) 0 -> FalseT
:=
  fun n => fun (pf: EqT nat (S n) 0) =>
    match pf in EqT _ x y
             return match x with
                    | 0   => match y with | 0 => TrueT | S _ => FalseT end
                    | S _ => match y with | 0 => FalseT | S _ => TrueT end
                    end
    with
    | eqrefl _ z => match z with
                    | 0 => TT
                    | S _ => TT
                    end
    end : FalseT.

Definition succ_is_not_0':
  forall n: nat, EqT nat (S n) 0 -> FalseT.
Proof.
  intros. inversion H.
Defined.

(*
Inductive EqT (A: Type) (x: A) : A -> Type :=
| eqrefl : EqT A x x
.

Definition succ_is_not_0:
  forall n: nat, EqT nat (S n) 0 -> FalseT
:=
  fun n => fun (pf: EqT nat (S n) 0) =>
    match pf in EqT _ _ y
             return match y with 0 => FalseT | S _ => TrueT end with
    | eqrefl _ _ => TT
    end.

Definition succ_is_not_0':
  forall n: nat, EqT nat (S n) 0 -> FalseT.
Proof.
intros. inversion H.
Defined.
*)

(*
  forall P: Prop (x y: P), x = y
*)

*)

(*
   9 Feb 2017 : Proposition
 *)

Definition istrue (b: bool) : Prop :=
  match b with
  | true => True
  | false => False
  end.

Print istrue.

Compute istrue true .

Compute istrue false.

Check (I: istrue true).

Definition true_is_true : istrue true
:= I.

(* Definition false_is_true : istrue false := ???. *)

Definition false_is_not_true :
 istrue false -> False
:=
  fun x : istrue false =>
    match x with
    end : False
.

(*
  P -> Q     P
  ------------
       Q

  e: P -> Q          e1 : P
 --------------------------
   e e1 : Q
*)

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

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

Definition two_plus_even_is_even :
  forall n:nat, istrue (evenb n) -> istrue (evenb (2 + n))
:=
  fun n:nat => fun pf: istrue (evenb n) => pf.

Check (
(fun n:nat => fun pf: istrue (evenb n) => pf)
:
(forall n:nat, istrue (evenb n) -> istrue (evenb (2 + n)))
).

Definition even_plus_two_is_even :
  forall n:nat, istrue (evenb n) -> istrue (evenb (n+2))
  :=
  fix even_plus_two_is_even n :=
    match n return istrue (evenb n) -> istrue (evenb (n+2)) with
    | 0 => fun x => x
    | 1 => fun x => x
    | S (S m) => fun x => even_plus_two_is_even m x
    end.

Check(
  (fix even_plus_two_is_even n :=
    match n return istrue (evenb n) -> istrue (evenb (n+2)) with
    | 0 => fun x => x
    | 1 => fun x => x
    | S (S m) => fun x => even_plus_two_is_even m x
    end)
  :
  (forall n:nat, istrue (evenb n) -> istrue (evenb (n+2)))
).

Inductive even: nat -> Prop :=
| zero_is_even : even 0
| succ_succ_even (n: nat) (pf: even n) : even (S (S n))
.

Check even.

Check (even: nat -> Type).

(*
* zero_is_even : even 0

* succ_succ_even 0 zero_is_even : even (S (S 0))

* succ_succ_even (S(S 0)) (succ_succ_even 0 zero_is_even) : even (S (S (S (S 0)))
*)

(*
Definition even' (n: nat) : Type :=
  exists m, n = 2 * m.
*)

(*
  e : vector (1 + n)    e: vector (S(n))

    e : T  S===T
   -------------
       e : S
*)

Definition two_plus_even_is_even' :
  forall n:nat, even n -> even (2+n)
  :=
  fun n:nat => fun pf: even n => succ_succ_even n (pf).

Definition even_plus_two_is_even' :
  forall n:nat, even n -> even (n+2)
  :=
  fix even_plus_two_is_even n :=
    match n return even n -> even (n+2) with
    | 0 | 1 => fun x => succ_succ_even _ x
    | S (S m) => fun pf : even (S (S m)) =>
      succ_succ_even (m+2) (
      even_plus_two_is_even m
      match pf in even k
        return (match k with 0 | 1 => True | S(S l) => even l end) : Prop
      with
      | zero_is_even => I
      | succ_succ_even m pf => pf
      end)
    end.

(* Compute (even_plus_two_is_even' 0 zero_is_even). *)

Theorem even_plus_two_is_even'':
  forall n:nat, even n -> even (n+2).
Proof.
  fix 1.
  intros. destruct n.
  - simpl. apply succ_succ_even.
    assumption.
  - destruct n.
    + apply succ_succ_even.
      assumption.
    + inversion H. subst. simpl.
      apply succ_succ_even.
      apply even_plus_two_is_even''.
      assumption.
Defined.

Print even_plus_two_is_even''.

Compute (even_plus_two_is_even'' 0 zero_is_even).

Definition induction_for_nat:
forall P : nat -> Prop,
  P 0 ->
  (forall n : nat, P n -> P (S n)) ->
forall n : nat, P n
:=
  fun P => fun (base: P 0) =>
  fun (step: forall n : nat, P n -> P (S n)) =>
  fix ind n :=
    match n return P n with
    | 0 => base
    | S m => step m (ind m)
    end.

Print eq.

Check (eq 0 0).

(* Inductive EqT (A: Type) : A -> A -> Prop := *)
(* | eqrefl (x: A) : EqT A x x *)
(* . *)

(* Check eqrefl. *)

(*

Definition succ_is_not_0:
  forall n: nat, S n = 0 -> False
:=
  fun n => fun (pf: S n = 0) =>
    match pf in x = y
             return match x with
                    | 0   => match y with | 0 => TrueT | S _ => FalseT end
                    | S _ => match y with | 0 => FalseT | S _ => TrueT end
                    end
    with
    | eqrefl _ z => match z with
                    | 0 => TT
                    | S _ => TT
                    end
    end : FalseT.

Definition succ_is_not_0':
  forall n: nat, EqT nat (S n) 0 -> FalseT.
Proof.
  intros. inversion H.
Defined.

*)

(* Inductive EqT (A: Type) : A -> A -> Prop := *)
(* | eqrefl (x: A) : EqT A x x *)
(* . *)

(*
Inductive EqT (A: Type) (x: A) : A -> Prop :=
| eqrefl : EqT A x x
.
*)

Definition succ_is_not_0:
  forall n: nat, S n = 0 -> False
:=
  fun n => fun (pf: S n = 0) =>
    match pf in _ = y
             return match y with 0 => False | S _ => True end with
    | eq_refl _ => I
    end.

Print eq.
Definition succ_is_not_0':
  forall n: nat, S n = 0 -> False.
Proof.
  intros. inversion H.
Defined.

(*
  forall P: Prop (x y: P), x = y
*)

Fixpoint sum n :=
  match n with
  | 0 => 0
  | S m => S m + sum m
  end.

Compute sum 100.

Require Import Lia.

Lemma sum_n_times:
  forall n, 2 * sum n = n * (n+1).
Proof.
  intros. induction n; simpl; lia.
Qed.

Print sum_n_times.

(*
  10 Feb 2017
 *)

(* forall, ->, =, P -> False, True, False, /\, \/, exists *)

(* Conjunction *)

(*
Inductive and (P: Prop) (Q: Prop) : Prop
:=
| conj (x: P) (y: Q) : and P Q
.

(1) a : P,  b: Q
 => conj a b : and P Q
*)

Print and.

Check (forall n: nat, n = 0 /\ (n = 1 -> False) : Prop).

(* Disjunction *)

(*
Inductive or (P: Prop) (Q: Prop) : Prop
:=
| left  (a: P) : or P Q
| right (b: Q) : or P Q
.
*)

Print or.

Check (forall n: nat, n = 0 \/ (n = 0 -> False) : Prop).

(*
Axiom axiom_of_choice:
  forall A B (R: A -> B -> Prop),
    (forall a: A, exists b: B, R a b) ->
    exists f: A -> B,
    forall a: A, R a (f a).
*)

(* Existential *)

(*
Inductive ex (A: Type) (P: A -> Prop) : Prop :=
| exist (a: A) (pf: P a) : ex A P
.
*)

Print ex.

Check (forall P: Prop, ((P->False)->False) -> P).

Check (forall P: Prop, P \/ P->False).

Check ((exists a:nat, exists b:nat, exists c:nat, a*a*a + b*b*b = c*c*c)
        -> False).

(*
  (exists a:A, e) === ex A (fun a => e)

  (exists b:A, P b)
  (exists ryu:A, P ryu)
*)

Lemma ryu: exists n, n = 0 \/ n = 1.
Proof.
  exists 0.
  left.
  auto.
Qed.

Require Import Program.

Lemma ryu2: (exists n, n = n+1) -> False.
Proof.
  intros EX.
  destruct EX as [n EQ].
  revert EQ.
  induction n.
  - intros. simpl in EQ. inversion EQ.
  - intros. simpl in EQ.
    apply IHn.
    dependent destruction EQ.
    assumption.
Qed.

Print ryu2.


(* Suppress some annoying warnings from Coq: *)
Set Warnings "-notation-overridden,-parsing".
From LF Require Export Lists.
(*ploy and highrt order functions*)
(*介绍一下polymorphism,多态。泛化能力是很重要的～*)
Inductive boollist:Type :=
  | bool_nil
  | bool_cons(b : bool)(l:boollist).
Inductive list(X:Type):Type :=
  | nil
  | cons (x:X)(l:list X).
Check list.
Check (nil bool).
Check (cons bool).
Check (cons bool true (nil bool)).
Check nil.
Check cons.
Check (cons nat 2 (cons nat 1 (nil nat))).
(*
list: Type -> Type
nil nat: list nat
cons nat: nat -> list nat -> list nat
cons nat 3 (nil nat): list nat
*)
Fixpoint repeat (X:Type)(x:X)(count:nat):list X:=
  match count with
  | 0=> nil X
  | S count' => cons X x (repeat X x count')
  end.
Example test_repeat1:
  repeat nat 4 2 = cons nat 4 (cons nat 4 (nil nat)).
Proof. reflexivity. Qed.
Example test_repeat2 :
  repeat bool false 1 = cons bool false (nil bool).
Proof. reflexivity. Qed.
(*
Exercise: 2 stars, standard (mumble_grumble)
Consider the following two inductively defined types.
*)
Module MumbleGrumble.
Inductive mumble : Type :=
  | a
  | b (x : mumble) (y : nat)
  | c.
Inductive grumble (X:Type) : Type :=
  | d (m : mumble)
  | e (x : X).
Check mumble.
Check a.
Check (b a 1).
Check c.
Check d nat (b a 1).
Check d bool (b a 1).
Check e bool.
Check e bool true.
(*e bool: bool -> grumble bool*)
(*e bool true: grumble bool*)
End MumbleGrumble.
(*Type Annotation Interface*)
Fixpoint repeat' X x count : list X :=
  match count with
  | 0 => nil X
  | S count' => cons X x (repeat' X x count')
  end.
Check repeat'.
(* ===> forall X : Type, X -> nat -> list X *)
Check repeat.
(* ===> forall X : Type, X -> nat -> list X *)
Fixpoint repeat'' X x count : list X :=
  match count with
  | 0 => nil _
  | S count' => cons _ x (repeat'' _ x count')
  end.
Definition list123 :=
  cons nat 1 (cons nat 2 (cons nat 3 (nil nat))).
Definition list123' :=
  cons _ 1 (cons _ 2 (cons _ 3 (nil _))).
Arguments nil {X}.
Arguments cons {X} _ _.
Arguments repeat {X} x count.
Fixpoint repeat''' {X : Type} (x : X) (count : nat) : list X :=
  match count with
  | 0 => nil
  | S count' => cons x (repeat''' x count')
  end.
Inductive list' {X:Type} : Type :=
  | nil'
  | cons' (x : X) (l : list').
Fixpoint app {X : Type} (l1 l2 : list X)
             : (list X) :=
  match l1 with
  | nil => l2
  | cons h t => cons h (app t l2)
  end.
Fixpoint rev {X:Type} (l:list X) : list X :=
  match l with
  | nil => nil
  | cons h t => app (rev t) (cons h nil)
  end.
Fixpoint length {X : Type} (l : list X) : nat :=
  match l with
  | nil => 0
  | cons _ l' => S (length l')
  end.
Example test_rev1 :
  rev (cons 1 (cons 2 nil)) = (cons 2 (cons 1 nil)).
Proof. reflexivity. Qed.
Example test_rev2:
  rev (cons true nil) = cons true nil.
Proof. reflexivity. Qed.
Example test_length1: length (cons 1 (cons 2 (cons 3 nil))) = 3.
Proof. reflexivity. Qed.
(* Supplying Type Arguments Explicitly *)
Definition mynil : list nat := nil.
Check @nil.
Definition mynil' := @nil nat.
Notation "x :: y" := (cons x y)
                     (at level 60, right associativity).
Notation "[ ]" := nil.
Notation "[ x ; .. ; y ]" := (cons x .. (cons y []) ..).
Notation "x ++ y" := (app x y)
                     (at level 60, right associativity).
Check [1;2;3].
Check [true;false;true].
Compute [1;2;3]++[1;2;3].

Definition list123''' := [1;2;3].
(* Exercise: 2 stars, standard, optional (poly_exercises) *)
Theorem app_nil_r : forall (X:Type), forall l:list X,
  l ++ [] = l.
Proof.
  intros X l. induction l as [| n l' IHl']. reflexivity.
  simpl. rewrite IHl'. reflexivity.
Qed.
Theorem app_assoc : forall A (l m n:list A),
  l ++ m ++ n = (l ++ m) ++ n.
Proof.
  intros A l m n. induction l as [| k l' IHl']. simpl. reflexivity.
  simpl. rewrite IHl'. reflexivity.
Qed.
Lemma app_length : forall (X:Type) (l1 l2 : list X),
  length (l1 ++ l2) = length l1 + length l2.
Proof.
  intros X l1 l2. induction l1 as [|n l1 IHl1']. reflexivity.
  simpl. rewrite IHl1'. reflexivity.
Qed.
(* Exercise: 2 stars, standard, optional (more_poly_exercises) *)
Theorem rev_app_distr: forall X (l1 l2 : list X),
  rev (l1 ++ l2) = rev l2 ++ rev l1.
Proof.
  intros X l1 l2. induction l1 as [| n l1' IHl1'].
  induction l2 as [| n l2' IHl2']. reflexivity. simpl.
  rewrite <- app_assoc. reflexivity.
  simpl. rewrite IHl1'. rewrite app_assoc. reflexivity.
Qed.
Theorem rev_involutive : forall X : Type, forall l : list X,
  rev (rev l) = l.
Proof.
  intros X l. induction l as [| n l' IHl']. reflexivity.
  simpl.
  rewrite  rev_app_distr. simpl. rewrite IHl'. reflexivity.
Qed.

(* Polymorphic Pairs *)
Inductive prod (X Y : Type) : Type :=
| pair (x : X) (y : Y).
Arguments pair {X} {Y} _ _.
Check pair nat nat.
Compute @pair.
Print pair.
Notation "( x , y )" := (pair x y).
Notation "X * Y" := (prod X Y) : type_scope.
Definition fst {X Y : Type} (p : X * Y) : X :=
  match p with
  | (x, y) => x
  end.
Definition snd {X Y : Type} (p : X * Y) : Y :=
  match p with
  | (x, y) => y
  end.
Fixpoint combine {X Y : Type} (lx : list X) (ly : list Y)
           : list (X*Y) :=
  match lx, ly with
  | [], _ => []
  | _, [] => []
  | x :: tx, y :: ty => (x, y) :: (combine tx ty)
  end.
Check list(prod nat nat).
Check @list(prod nat nat).
Check list(@prod nat nat).
Check (@fst (prod nat nat)).
Check list _.
Check (prod (list nat) (list nat)).
Check @nil _.
Check @nil nat.
Check prod Type Type.
Check prod (list nat) (list nat).
Check (nat * nat)%type.
(* Exercise: 1 star, standard, optional (combine_checks) *)
Check @combine.
Check list nat.
Check (@nil nat).
Check (@nil nat).
Check prod (list nat) (list nat).
Check ((list nat) * (list nat))%type.
Check (nil,nil).
Check (list nat*list nat)%type.
Check (list nat,list nat).
Check (@nil nat,@nil nat).
Check @fst (nat*nat)%type.
Check @fst.
Check fst.
Check (nat*nat)%type.
(* Exercise: 2 stars, standard, recommended (split) *)
Fixpoint split {X Y : Type} (l : list (X*Y))
               : (list X) * (list Y) :=
  match l with
  | [] => ((@nil X) , (@nil Y))
  | (x,y)::t => ((x:: (fst (split t)) , y::(snd (split t))))
  end.
Example test_split:
  split [(1,false);(2,false)] = ([1;2],[false;false]).
Proof. simpl. reflexivity. Qed.
(* Polymorphic Options *)
Module OptionPlayground.
Inductive option (X:Type) : Type :=
  | Some (x : X)
  | None.
Arguments Some {X} _.
Arguments None {X}.
End OptionPlayground.
Fixpoint nth_error {X : Type} (l : list X) (n : nat)
                   : option X :=
  match l with
  | [] => None
  | a :: l' => if n =? O then Some a else nth_error l' (pred n)
  end.
Example test_nth_error1 : nth_error [4;5;6;7] 0 = Some 4.
Proof. reflexivity. Qed.
Example test_nth_error2 : nth_error [[1];[2]] 1 = Some [2].
Proof. reflexivity. Qed.
Example test_nth_error3 : nth_error [true] 2 = None.
Proof. reflexivity. Qed.
(* Exercise: 1 star, standard, optional (hd_error_poly) *)
Definition hd_error {X : Type} (l : list X) : option X :=
  match l with
  | [] => None
  | h :: t => Some h
  end.
Check @hd_error.
Example test_hd_error1 : hd_error [1;2] = Some 1.
Proof. simpl. reflexivity. Qed.
Example test_hd_error2 : hd_error [[1];[2]] = Some [1].
Proof. simpl. reflexivity. Qed.
(*Functions as Data*)
(* Higher-Order Functions *)
Definition doit3times {X:Type} (f:X->X) (n:X) : X :=
  f (f (f n)).
Check @doit3times.
Example test_doit3times': doit3times negb true = false.
Proof. reflexivity. Qed.
Fixpoint filter {X:Type} (test: X -> bool) (l:list X)
                : (list X) :=
  match l with
  | [] => []
  | h :: t => if test h then h :: (filter test t)
                        else filter test t
  end.
Example test_filter1: filter evenb [1;2;3;4] = [2;4].
Proof. reflexivity. Qed.
Definition length_is_1 {X : Type} (l : list X) : bool :=
  (length l) =? 1.
Example test_filter2:
    filter length_is_1
           [ [1; 2]; [3]; [4]; [5;6;7]; []; [8] ]
  = [ [3]; [4]; [8] ].
Proof. reflexivity. Qed.
(*匿名函数*)
Example test_anon_fun':
  doit3times (fun n=>n*n) 2 = 256.
Proof. reflexivity. Qed.
Example test_filter2':
  filter (fun l=> (length l)=? 1)
    [[1; 2];[3];[4];[5;6;7];[];[8]]=[[3];[4];[8]].
Proof. reflexivity. Qed.
(*
Exercise: 2 stars, standard (filter_even_gt7)
Use filter (instead of Fixpoint) to write a Coq function filter_even_gt7
that takes a list of natural numbers as input
and returns a list of just those that are even and greater than 7.
*)
Definition filter_even_gt7 (l : list nat) : list nat :=
  filter (fun x => 7 <=? x) (filter evenb l).
Example test_filter_even_gt7_1 :
  filter_even_gt7 [1;2;6;9;10;3;12;8] = [10;12;8].
Proof. reflexivity. Qed.
Example test_filter_even_gt7_2 :
  filter_even_gt7 [5;2;6;19;129] = [].
Proof. reflexivity. Qed.
(*
Exercise: 3 stars, standard (partition)
Use filter to write a Coq function partition:
      partition : ∀X : Type,
                  (X → bool) → list X → list X * list X
Given a set X, a test function of type X → bool and a list X,
partition should return a pair of lists.
The first member of the pair is the sublist of the original list
containing the elements that satisfy the test, and the second is
the sublist containing those that fail the test. The order of elements
in the two sublists should be the same as their order in the original list.
*)
Definition partition {X : Type}
                     (test : X -> bool)
                     (l : list X)
                   : list X * list X
  := (filter test l ,filter (fun x=> negb (test x)) l).

Example test_partition1: partition oddb [1;2;3;4;5] = ([1;3;5], [2;4]).
Proof. reflexivity. Qed.
Example test_partition2: partition (fun x => false) [5;9;0] = ([], [5;9;0]).
Proof. reflexivity. Qed.
(*Map,映射操作。给出一个[x1 x2 ... xn],得到[f x1 f x2 ... f xn]*)
Fixpoint map {X Y: Type} (f:X->Y) (l:list X) : (list Y) :=
  match l with
  | [] => []
  | h :: t => (f h) :: (map f t)
  end.
Example test_map1: map (fun x => plus 3 x) [2;0;2] = [5;3;5].
Proof. reflexivity. Qed.
Example test_map2 : map (fun n => [evenb n;oddb n]) [2;1;2;5]
  = [[true;false];[false;true];[true;false];[false;true]].
Proof. reflexivity. Qed.

Example test_map3:
    map (fun n => [evenb n;oddb n]) [2;1;2;5]
  = [[true;false];[false;true];[true;false];[false;true]].
Proof. reflexivity. Qed.
(*Exercise: 3 stars, standard (map_rev)
Show that map and rev commute. You may need to define an auxiliary lemma.
*)

Theorem map_theo: forall (X Y:Type) (f:X->Y)(l:list X)(k: X),
  map f (l ++ [k]) = map f (l) ++ [f k].
Proof.
  intros X Y f l k. induction l as [| n l' IHl']. reflexivity.
  simpl. rewrite IHl'. reflexivity.
Qed.
Theorem map_rev : forall (X Y : Type) (f : X -> Y) (l : list X),
  map f (rev l) = rev (map f l).
Proof.
  intros X Y f l.
  induction l as [| n l' IHl']. reflexivity.
  simpl. rewrite <- IHl'. rewrite map_theo. reflexivity.
Qed.

(* Exercise: 2 stars, standard, recommended (flat_map)
The function map maps a list X to a list Y using a function of type X → Y.
We can define a similar function, flat_map,
which maps a list X to a list Y using a function f of type X → list Y.
Your definition should work by 'flattening' the results of f.*)
Fixpoint flat_map {X Y: Type} (f: X -> list Y) (l: list X)
                   : (list Y) :=
  match l with
  | [] => []
  | h :: t => (f h) ++ (flat_map f t)
  end.
Example test_flat_map1:
  flat_map (fun n => [n;n;n]) [1;5;4]
  = [1; 1; 1; 5; 5; 5; 4; 4; 4].
Proof. reflexivity. Qed.

Definition option_map {X Y : Type} (f : X -> Y) (xo : option X)
                      : option Y :=
  match xo with
    | None => None
    | Some x => Some (f x)
  end.
(*Fold => map reduce的函数式特性*)
Fixpoint fold {X Y:Type} (f: X->Y->Y)(l:list X)(b:Y):Y :=
  match l with
  | nil => b
  | h :: t => f h (fold f t b)
  end.
Compute fold plus [1;2;3;4] 0.
Check fold andb.

Example fold_example1:
  fold mult [1;2;3;4] 1 = 24.
Proof. reflexivity. Qed.
Example fold_example2:
  fold andb [true;false] true = false.
Proof. reflexivity. Qed.

Example fold_example3:
  fold app [[1];[];[2;3];[4]] [9] = [1;2;3;4;9].
Proof. reflexivity. Qed.
(*构造函数的函数：Functions That Construct Functions*)
Definition constfun {X:Type} (x:X): nat->X:=
  fun (k:nat) => x.
(*上面的例子使用匿名函数作为函数的返回值*)
Definition ftrue := constfun true.
Example constfun_exp1: ftrue 0 = true.
Proof. reflexivity. Qed.
Example constfun_exp2: ftrue 1 = true.
Proof. reflexivity. Qed.
(*ftrue忽略参数nat的值，只返回true（意义何在.....*)
Check plus.
Definition plus3 := plus 3.
Check plus3.
Example test_plus3 : plus3 4 = 7.
Proof. reflexivity. Qed.
Example test_plus3' : doit3times plus3 0 = 9.
Proof. reflexivity. Qed.
Example test_plus3'' : doit3times (plus 3) 0 = 9.
Proof. reflexivity. Qed.
(*Additional Exercise*)
Module Exercises.
(* Exercise: 2 stars, standard (fold_length) *)
Definition fold_length {X : Type} (l : list X) : nat :=
  fold (fun _ n => S n) l 0.
Example test_fold_length1 : fold_length [4;7;0] = 3.
Proof. reflexivity. Qed.
Theorem fold_length_correct : forall X (l : list X),
  fold_length l = length l.
Proof.
  intros X l. induction l as [| n l' IHl']. reflexivity.
  simpl. rewrite <- IHl'. reflexivity.
Qed.
Check andb.
(* Exercise: 3 stars, standard (fold_map)
We can also define map in terms of fold. Finish fold_map below. *)
Definition fold_map {X Y: Type} (f: X -> Y) (l: list X) : list Y :=
  match l with
  | [] => []
  | h :: t => fold (fun h t => (f h)::t) l []
  end.
Example test_fold_map1 : fold_map oddb [2;1;2;5] = [false;true;false;true].
Proof. reflexivity. Qed.
Example test_fold_map2: fold_map (fun x => plus 3 x) [2;0;2] = [5;3;5].
Proof. reflexivity. Qed.
Example test_fold_map3:
    fold_map (fun n => [evenb n;oddb n]) [2;1;2;5]
  = [[true;false];[false;true];[true;false];[false;true]].
Proof. reflexivity. Qed.
(* Exercise: 2 stars, advanced (currying) *)
Definition prod_curry {X Y Z : Type}
  (f : X * Y -> Z) (x : X) (y : Y) : Z := f (x, y).
Definition prod_uncurry {X Y Z : Type}
  (f : X -> Y -> Z) (p : X * Y) : Z := f (fst p) (snd p).
Example test_map1': map (plus 3) [2;0;2] = [5;3;5].
Proof. reflexivity. Qed.
Check @prod_curry.
Check @prod_uncurry.
Theorem uncurry_curry : forall (X Y Z : Type)
                        (f : X -> Y -> Z)
                        x y,
  prod_curry (prod_uncurry f) x y = f x y.
Proof.
  intros X Y Z f x y. reflexivity.
Qed.
Theorem curry_uncurry : forall (X Y Z : Type)
                        (f : (X * Y) -> Z) (p : X * Y),
  prod_uncurry (prod_curry f) p = f p.
Proof.
  intros X Y Z f p. destruct p. reflexivity.
Qed.
(* Exercise: 2 stars, advanced (nth_error_informal)*)
 Fixpoint nth_error {X : Type} (l : list X) (n : nat) : option X :=
     match l with
     | [] => None
     | a :: l' => if n =? O then Some a else nth_error l' (pred n)
     end.
(*
informal proof...do not do formal!!!!aaaaAAAA
Theorem nth_error_theo : forall X n l,
  length l = n -> @nth_error X l n = None.
Proof.
  intros X n l H. rewrite <- H.
  induction l as [| n' l' IHl']. reflexivity.
  apply
  simpl. rewrite IHl'. reflexivity.
  rewrite <- H. simpl.
Qed.
*)
(*
The following exercises explore an alternative way of defining natural numbers, using the so-called Church numerals, named after mathematician Alonzo Church. We can represent a natural number n as a function that takes a function f as a parameter and returns f iterated n times.
*)
Module Church.
Definition cnat := forall X : Type, (X -> X) -> X -> X.
Definition one : cnat :=
  fun (X : Type) (f : X -> X) (x : X) => f x.
Definition two : cnat :=
  fun (X : Type) (f : X -> X) (x : X) => f (f x).
Definition zero : cnat :=
  fun (X : Type) (f : X -> X) (x : X) => x.
Definition three : cnat := @doit3times.
Compute  fun (X : Type) (f : X -> X) (x : X) => f x.
Compute one bool negb false.
Compute two bool negb false.
Compute negb false.
Compute negb (negb false).
Compute one (bool->bool) (one bool) negb false.
Compute one nat S O.
Compute one nat S (one nat S O).
Compute two nat S O.
Compute one nat S (two nat S O).
Compute one (nat->nat) (two nat) S O.
(* Exercise: 1 star, advanced (church_succ) *)
Definition succ (n : cnat) : cnat :=
  fun (X : Type)(f:X->X)(x:X)=> (one X f) (n X f x).
Compute zero nat S O.
Compute succ zero nat S O.
Compute one nat S O.
Compute succ one nat S O.
Compute two nat S O.
Compute succ two nat S O.
Compute three nat S O.
Compute succ three nat S O.
Example succ_1 : succ zero = one.
Proof. reflexivity. Qed.
Example succ_2 : succ one = two.
Proof. reflexivity. Qed.
Example succ_3 : succ two = three.
Proof. reflexivity. Qed.
(*耶!!!!!!虽然只是1星习题但是好~开~心~*)
(*
Exercise: 1 star, advanced (church_plus)
Addition of two natural numbers:
*)
Definition plus (n m : cnat) : cnat :=
  fun (X : Type)(f:X->X)(x:X)=>  (m X f) (n X f x).
Example plus_1 : plus zero one = one.
Proof. reflexivity. Qed.
Example plus_2 : plus two three = plus three two.
Proof. reflexivity. Qed.
Example plus_3 :
  plus (plus two two) three = plus one (plus three three).
Proof. reflexivity. Qed.
Compute one nat S O.
(*
Exercise: 2 stars, advanced (church_mult)
Multiplication:
*)
Definition mult (n m : cnat) : cnat :=
 fun (X : Type)(f:X->X)(x:X)=> m X (n X f) x.
Compute mult one zero nat S O.
Compute mult two one nat S O.
Compute mult three two nat S O.
Compute mult two three nat S O.
Example mult_1 : mult one one = one.
Proof. reflexivity. Qed.
Example mult_2 : mult zero (plus three three) = zero.
Proof. reflexivity. Qed.
Example mult_3 : mult two three = plus three three.
Proof. reflexivity. Qed.
(* Exercise: 2 stars, advanced (church_exp)
Exponentiation:
(Hint: Polymorphism plays a crucial role here. However, choosing the right type to iterate over can be tricky. If you hit a "Universe inconsistency" error, try iterating over a different type. Iterating over cnat itself is usually problematic.)
*)
Definition exp (n m : cnat) : cnat :=
  fun (X : Type)=> m (X->X) (n X).
Compute exp one two nat S O.
Compute exp two two nat S O.
Compute exp three two nat S O.
Compute exp two three nat S O.
Example exp_1 : exp two two = plus two two.
Proof. reflexivity. Qed.
Example exp_2 : exp three zero = one.
Proof. reflexivity. Qed.
Example exp_3 : exp three two = plus (mult two (mult two two)) one.
Proof. reflexivity. Qed.
End Church.
End Exercises.


From mathcomp Require Import ssreflect ssrfun ssrbool.

(** Prove the following lemmas by providing explicit proof terms.
A bunch of exercises from the previous seminar we didn't have time
to cover have made it to this homework :) *)

(* An (unsound) placeholder so that the whole file typechecks.
Please replace it with your proof term. Your solutions may not
use any axioms, including `replace_with_your_solution_here` *)
Axiom replace_with_your_solution_here : forall {A : Type}, A.

Section Logic.

Variables A B C : Prop.
Definition exfalso_quodlibet :
    False -> A
:= fun pF : False => match pF with end.

(** * Exercise *)
Definition notTrue_iff_False : (~ True) <-> False
:= conj
  (fun f : (True -> False) => f I)
  (fun x : False => match x with end).
Locate "<->".
Print iff.
(* Hint 1: use [Locate "<->".] and [Print iff.] commands to understand better
the type above. *)

(* Hint 2: If you are experiencing an error like the following one
"Found a matching with no clauses on a term unknown to have an empty inductive type." try adding explicit type annotations to functional parameters or
use `match <term> in <type> with ... end` instead of `match <term> with ... end` *)

(** * Exercise: double negation elimination works for `False` *)
Definition dne_False : ~ ~ False -> False
:= fun f : ((False -> False) -> False) => f id.
Print id.

(** * Exercise: double negation elimination works for `True` too. *)
Definition dne_True : ~ ~ True -> True
:= fun f : ((True -> False) -> False) => I.

(** * Exercise: Weak Peirce's law
Peirce's law (https://en.wikipedia.org/wiki/Peirce%27s_law) is equivalent to
Double Negation Elimination (and the Law of Excluded Middle too),
so it does not hold in general, but we can prove its weak form. *)
(*
Definition weak_Peirce : ((((A -> B) -> A) -> A) -> B) -> B
:= fun abaab : ((((A -> B) -> A) -> A) -> B) => A.
*)
(* Hint 1: use let-in expression to break the proof into pieces and solve them independently *)
(* Hint 2: annotate the identifiers of let-expressions with types: [let x : <type> := ... in ...] *)

Variable T : Type.
Variable P Q : T -> Prop.

(** * Exercise: existential introduction rule *)
Definition exists_introduction :
  forall (x : T), P x -> (exists (x : T), P x)
:= fun t : T => fun pt : P t => (ex_intro P t pt).

(** * Exercise: Frobenius rule: existential quantifiers and conjunctions commute *)
Definition frobenius_rule :
  (exists x, A /\ P x) <-> A /\ (exists x, P x)
:= conj
    (fun exAPx =>
      match exAPx with
        | (ex_intro x APx) =>
          match APx with
            | (conj pA Px) => conj pA (ex_intro _ x Px)
          end
      end)
    (fun AexPx =>
      match AexPx with
        | (conj pA exPx) =>
          match exPx with
            | (ex_intro x px) => (ex_intro _ x (conj pA px))
          end
      end).

End Logic.

Section Equality.

Variables A B C D : Type.

(** * Exercise *)
Definition eq1 : true = (true && true)
:= eq_refl (true && true).

(** * Exercise *)
Definition eq2 : 42 = (if true then 21 + 21 else 239)
:= eq_refl (if true then 21 + 21 else 239).

Variable t : bool.
Compute t || ~~ t.
Locate "_ || _".

(** * Exercise *)
Definition LEM_decidable :
  forall (b : bool), b || ~~ b = true
:= fun b : bool =>
    match b return (b || ~~ b = true) with
    | true => erefl true
    | false => erefl true
    end.
Print LEM_decidable.
(** * Exercise *)
Definition if_neg :
  forall (A : Type) (b : bool) (vT vF: A),
    (if ~~ b then vT else vF) = if b then vF else vT
:= fun _ b vT vF =>
    match b as c return ((if ~~ c then vT else vF) = if c then vF else vT)
    with
    | true => erefl vF
    | false => erefl vT
    end.

(** * Exercise : associativity of function composition *)
(** [\o] is a notation for function composition in MathComp, prove that it's associative *)

Definition compA (f : A -> B) (g : B -> C) (h : C -> D) :
  (h \o g) \o f = h \o (g \o f)
:= replace_with_your_solution_here.

(** [=1] stands for extensional equality on unary functions,
    i.e. [f =1 g] means [forall x, f x = g x].
    This means it's an equivalence relation, i.e. it's reflexive, symmetric and transitive.
    Let us prove a number of facts about [=1]. *)

(** * Exercise: Reflexivity *)
Definition eqext_refl :
  forall (f : A -> B), f =1 f
:= replace_with_your_solution_here.

(** * Exercise: Symmetry *)
Definition eqext_sym :
  forall (f g : A -> B), f =1 g -> g =1 f
:= replace_with_your_solution_here.

(** * Exercise: Transitivity *)
Definition eqext_trans :
  forall (f g h : A -> B), f =1 g -> g =1 h -> f =1 h
:= replace_with_your_solution_here.

(** * Exercise: left congruence *)
Definition eq_compl :
  forall (f g : A -> B) (h : B -> C),
    f =1 g -> h \o f =1 h \o g
:= replace_with_your_solution_here.

(** * Exercise: right congruence *)
Definition eq_compr :
  forall (f g : B -> C) (h : A -> B),
    f =1 g -> f \o h =1 g \o h
:= replace_with_your_solution_here.

End Equality.

(** * Extra exercises (feel free to skip) *)

From mathcomp Require Import ssreflect ssrfun ssrbool eqtype.

(* After importing `eqtype` you need to either use a qualified name for
`eq_refl`: `Logic.eq_refl`, or use the `erefl` notation.
This is because `eqtype` reuses the `eq_refl` identifier for a
different lemma.
 *)

Definition iff_is_if_and_only_if :
  forall a b : bool, (a ==> b) && (b ==> a) = (a == b)
:= replace_with_your_solution_here.

Definition negbNE :
  forall b : bool, ~~ ~~ b = true -> b = true
:= replace_with_your_solution_here.


Inductive ev : nat -> Prop :=
| ev_0 : ev 0
| ev_SS : forall n : nat, ev n -> ev (S (S n)).

Theorem ev_2 : ev 2.
Proof. apply (ev_SS 0 ev_0). Qed.

Theorem add_even_even : forall {n m : nat}, ev m -> ev n -> ev (m + n).
Proof.
  intros n m Hm Hn.
  induction Hm.
    { simpl. apply Hn. }
    { simpl. apply ev_SS. apply IHHm. }
Qed.

Theorem ev_4_alt : ev 4.
Proof.
  apply (add_even_even ev_2 ev_2).
Qed.


(* Exercise 39 *)

Require Import BenB.

Variable D : Set.
Variables P Q S T : D -> Prop.
Variable R : D -> D -> Prop.

Theorem exercise_039 : ~ (exists x, P x \/ Q x) -> (forall x, ~ P x /\ ~ Q x).
Proof.
imp_i a1.
all_i a.
con_i.
neg_e' (exists x:D, P x \/ Q x) a2.
hyp a1.
exi_i a.
dis_i1.
neg_e' (~(P a)) a3.
hyp a2.
hyp a3.
neg_e' (exists x:D, P x \/ Q x) a2.
hyp a1.
exi_i a.
dis_i2.
neg_e' (~(Q a)) a3.
hyp a2.
hyp a3.
Qed.


Require Import ssreflect.

(**
# 第8回

http://qnighy.github.io/coqex2014/ex6.html

## 課題38 (種別:A / 締め切り : 2014/06/01)

モノイドを型クラスとして定義する。以下の空欄を埋めよ。
*)

(* モノイド *)
Class Monoid (T : Type) := {
  mult : T -> T -> T
    where "x * y" := (mult x y);
  one : T
    where "1" := one;
  mult_assoc x y z : x * (y * z) = (x * y) * z;
  mult_1_l x : 1 * x = x;
  mult_1_r x : x * 1 = x
}.

Delimit Scope monoid_scope with monoid.
Local Open Scope monoid_scope.

Notation "x * y" := (mult x y) : monoid_scope.
Notation "1" := one : monoid_scope.

(* モノイドのリストの積 *)
Require Import List.
Check @fold_right bool bool.
Check @mult.

Definition product_of {T : Type} {M : Monoid T} : list T -> T :=
  fun (l : list T) => fold_right mult 1 l.
(* @fold_right T T (@mult T M) 1 l *)

(* 自然数の最大値関数に関するモノイド *)
Require Import Arith.
Check max.
Program Instance MaxMonoid : Monoid nat :=
  {|
    mult x y := max x y;
    one := 0
  |}.
Next Obligation.                            (* max x (max y z) = max (max x y) z *)
  by rewrite Max.max_assoc.
Qed.
Next Obligation.                            (* max x 0 = 0 *)
  by rewrite Max.max_0_r.
Qed.

Eval compute in product_of (3 :: 2 :: 6 :: 4 :: nil). (* => 6 *)
Eval compute in product_of (@nil nat). (* => 0 *)

(**
ヒント

Classの実体はRecordです。Classとして宣言すると、型クラスのように自動でインスタンスを探しに
行くようになり、インスタンスを明示する必要がなくなります。SetoidやProperもクラスです。

*)

(* END *)


Require Export P08.

(** **** Exercise: 3 stars, optional (fold_bexp_Eq_informal)  *)
(** Here is an informal proof of the [BEq] case of the soundness
    argument for boolean expression constant folding.  Read it
    carefully and compare it to the formal proof that follows.  Then
    fill in the [BLe] case of the formal proof (without looking at the
    [BEq] case, if possible).

   _Theorem_: The constant folding function for booleans,
   [fold_constants_bexp], is sound.

   _Proof_: We must show that [b] is equivalent to [fold_constants_bexp],
   for all boolean expressions [b].  Proceed by induction on [b].  We
   show just the case where [b] has the form [BEq a1 a2].

   In this case, we must show

       beval st (BEq a1 a2)
     = beval st (fold_constants_bexp (BEq a1 a2)).

   There are two cases to consider:

     - First, suppose [fold_constants_aexp a1 = ANum n1] and
       [fold_constants_aexp a2 = ANum n2] for some [n1] and [n2].

       In this case, we have

           fold_constants_bexp (BEq a1 a2)
         = if beq_nat n1 n2 then BTrue else BFalse

       and

           beval st (BEq a1 a2)
         = beq_nat (aeval st a1) (aeval st a2).

       By the soundness of constant folding for arithmetic
       expressions (Lemma [fold_constants_aexp_sound]), we know

           aeval st a1
         = aeval st (fold_constants_aexp a1)
         = aeval st (ANum n1)
         = n1

       and

           aeval st a2
         = aeval st (fold_constants_aexp a2)
         = aeval st (ANum n2)
         = n2,

       so

           beval st (BEq a1 a2)
         = beq_nat (aeval a1) (aeval a2)
         = beq_nat n1 n2.

       Also, it is easy to see (by considering the cases [n1 = n2] and
       [n1 <> n2] separately) that

           beval st (if beq_nat n1 n2 then BTrue else BFalse)
         = if beq_nat n1 n2 then beval st BTrue else beval st BFalse
         = if beq_nat n1 n2 then true else false
         = beq_nat n1 n2.

       So

           beval st (BEq a1 a2)
         = beq_nat n1 n2.
         = beval st (if beq_nat n1 n2 then BTrue else BFalse),

       as required.

     - Otherwise, one of [fold_constants_aexp a1] and
       [fold_constants_aexp a2] is not a constant.  In this case, we
       must show

           beval st (BEq a1 a2)
         = beval st (BEq (fold_constants_aexp a1)
                         (fold_constants_aexp a2)),

       which, by the definition of [beval], is the same as showing

           beq_nat (aeval st a1) (aeval st a2)
         = beq_nat (aeval st (fold_constants_aexp a1))
                   (aeval st (fold_constants_aexp a2)).

       But the soundness of constant folding for arithmetic
       expressions ([fold_constants_aexp_sound]) gives us

         aeval st a1 = aeval st (fold_constants_aexp a1)
         aeval st a2 = aeval st (fold_constants_aexp a2),

       completing the case.  []
*)

Theorem fold_constants_bexp_sound:
  btrans_sound fold_constants_bexp.
Proof.
  unfold btrans_sound. intros b. unfold bequiv. intros st.
  induction b;
    (* BTrue and BFalse are immediate *)
    try reflexivity.
  - (* BEq *)
    rename a into a1. rename a0 into a2. simpl.

    (** (Doing induction when there are a lot of constructors makes
        specifying variable names a chore, but Coq doesn't always
        choose nice variable names.  We can rename entries in the
        context with the [rename] tactic: [rename a into a1] will
        change [a] to [a1] in the current goal and context.) *)

    remember (fold_constants_aexp a1) as a1' eqn:Heqa1'.
    remember (fold_constants_aexp a2) as a2' eqn:Heqa2'.
    replace (aeval st a1) with (aeval st a1') by
       (subst a1'; rewrite <- fold_constants_aexp_sound; reflexivity).
    replace (aeval st a2) with (aeval st a2') by
       (subst a2'; rewrite <- fold_constants_aexp_sound; reflexivity).
    destruct a1'; destruct a2'; try reflexivity.

      (** The only interesting case is when both a1 and a2
          become constants after folding *)

      simpl. destruct (beq_nat n n0); reflexivity.
  - (* BLe *)
    rename a into a1. rename a0 into a2. simpl.
    remember (fold_constants_aexp a1) as a1' eqn:Heqa1'.
    remember (fold_constants_aexp a2) as a2' eqn:Heqa2'.
    replace (aeval st a1) with (aeval st a1') by
       (subst a1'; rewrite <- fold_constants_aexp_sound; reflexivity).
    replace (aeval st a2) with (aeval st a2') by
        (subst a2'; rewrite <- fold_constants_aexp_sound; reflexivity).
    destruct a1'; destruct a2'; try reflexivity.
    simpl. destruct (leb n n0); reflexivity.
  - (* BNot *)
    simpl. remember (fold_constants_bexp b) as b' eqn:Heqb'.
    rewrite IHb.
    destruct b'; reflexivity.

  - (* BAnd *)
    simpl.
    remember (fold_constants_bexp b1) as b1' eqn:Heqb1'.
    remember (fold_constants_bexp b2) as b2' eqn:Heqb2'.
    rewrite IHb1. rewrite IHb2.
    destruct b1'; destruct b2'; reflexivity.
Qed.


(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Unset Positivity Checking.
Unset Guard Checking.

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

Inductive natural : Set :=
| Zero : natural
| Succ : natural -> natural.

Fixpoint plus (plus_arg0 : natural) (plus_arg1 : natural) {struct plus_arg0}
  : natural :=
  match plus_arg0 with
  | Zero => plus_arg1
  | Succ n => Succ (plus n plus_arg1)
  end.

Fixpoint mult (mult_arg0 : natural) (mult_arg1 : natural) {struct mult_arg0}
  : natural :=
  match mult_arg0 with
  | Zero => Zero
  | Succ n => plus (mult n mult_arg1) mult_arg1
  end.

Definition synth (lf1 : natural) (z : natural) (x : natural) : natural :=
  plus (mult x z) lf1.


Require Import Reals.
Require Import Interval.Tactic.

Open Scope R_scope.

Goal
  forall x, -1 <= x <= 1 ->
  sqrt (1 - x) <= 3/2.
Proof.
  intros.
  interval.
Qed.

Goal
  forall x, -1 <= x <= 1 ->
  sqrt (1 - x) <= 141422/100000.
Proof.
  intros.
  interval.
Qed.

Goal
  forall x, -1 <= x <= 1 ->
  sqrt (1 - x) <= 141422/100000.
Proof.
  intros.
  interval_intro (sqrt (1 - x)) upper as H'.
  apply Rle_trans with (1 := H').
  interval.
Qed.

Goal
  forall x, 3/2 <= x <= 2 ->
  forall y, 1 <= y <= 33/32 ->
  Rabs (sqrt(1 + x/sqrt(x+y)) - 144/1000*x - 118/100) <= 71/32768.
Proof.
  intros.
  interval with (i_prec 19, i_bisect x).
Qed.

Goal
  forall x, 1/2 <= x <= 2 ->
  Rabs (sqrt x - (((((122 / 7397 * x + (-1733) / 13547) * x
                   + 529 / 1274) * x + (-767) / 999) * x
                   + 407 / 334) * x + 227 / 925))
    <= 5/65536.
Proof.
  intros.
  interval with (i_bisect x, i_taylor x, i_degree 3).
Qed.

Goal
  forall x, -1 <= x ->
  x < 1 + powerRZ x 3.
Proof.
  intros.
  apply Rminus_lt.
  interval with (i_bisect x, i_autodiff x).
Qed.

Require Import Coquelicot.Coquelicot.

Goal
  Rabs (RInt (fun x => atan (sqrt (x*x + 2)) / (sqrt (x*x + 2) * (x*x + 1))) 0 1
        - 5/96*PI*PI) <= 1/1000.
Proof.
  integral with (i_fuel 2, i_degree 5).
Qed.

Goal
  RInt_gen (fun x => 1 * (powerRZ x 3 * ln x^2))
           (at_right 0) (at_point 1) = 1/32.
Proof.
  refine ((fun H => Rle_antisym _ _ (proj2 H) (proj1 H)) _).
  integral with (i_prec 10).
Qed.

(*
Goal
  Rabs (RInt_gen (fun t => 1/sqrt t * exp (-(1*t)))
                 (at_point 1) (Rbar_locally p_infty)
        - 2788/10000) <= 1/1000.
Proof.
  interval.
Qed.
*)


(* filtering_lists.v *)
(* dIFP 2014-2015, Q1 *)
(* Teacher: Olivier Danvy <danvy@cs.au.dk> *)

(* Student name: Benjamin Nørgaard *)
(* Student number: 201209884 *)

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

(* The goal of this project is to study
   how to filter elements in or out of lists.
*)

Require Import List Bool.

Ltac unfold_tactic name :=
  intros; unfold name;
  reflexivity.

(* The Bool library defines
     true,
     false,
     andb (noted && in infix notation),
     orb (noted || in infix notation),
     and negb.
   It also provides the following equations:

    andb_true_l : forall b : bool, true && b = b
    andb_true_r : forall b : bool, b && true = b
   andb_false_l : forall b : bool, false && b = false
   andb_false_r : forall b : bool, b && false = false
    orb_false_l : forall b : bool, false || b = b
    orb_false_r : forall b : bool, b || false = b
     orb_true_r : forall b : bool, b || true = true
     orb_true_l : forall b : bool, true || b = true

   andb_true_iff
        : forall b1 b2 : bool, b1 && b2 = true <-> b1 = true /\ b2 = true
   andb_false_iff:
     forall b1 b2 : bool, b1 && b2 = false <-> b1 = false \/ b2 = false
   orb_false_iff
        : forall b1 b2 : bool, b1 || b2 = false <-> b1 = false /\ b2 = false
   orb_true_iff
        : forall b1 b2 : bool, b1 || b2 = true <-> b1 = true \/ b2 = true

You will also have the use of the two following unfold lemmas:
*)

Lemma unfold_negb_base_case_true :
  negb true = false.
Proof.
  unfold_tactic negb.
Qed.

Lemma unfold_negb_base_case_false :
  negb false = true.
Proof.
  unfold_tactic negb.
Qed.

(* Also, when, among the assumptions, you have
     H_foo : true = false
   remember that the command
     discriminate H_foo.
   solves the current subgoal.
*)

(* And finally, remember that
      destruct blah as [...] eqn:H_blah.
    has the niceness of adding an assumption H_blah
    that reflects the destruction.  For example,
    if foo has type bool,
      destruct foo as [ | ] eqn:H_foo.
    will successively provide
      H_foo : foo = true
    and then
      H_foo : foo = false
*)

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

(* All of that said, here is a specification: *)

Definition specification_of_filter_in (filter_in : (nat -> bool) -> list nat -> list nat) :=
  (forall p : nat -> bool,
     filter_in p nil = nil)
  /\
  (forall (p : nat -> bool)
          (x : nat)
          (xs' : list nat),
     p x = true ->
     filter_in p (x :: xs') = x :: (filter_in p xs'))
  /\
  (forall (p : nat -> bool)
          (x : nat)
          (xs' : list nat),
     p x = false ->
     filter_in p (x :: xs') = filter_in p xs').

(* You are asked to:

   * write unit tests for filter_in;

   * prove whether this definition specifies a unique function;

   * implement a definition of filter_in that satisfies the
     specification;

   * prove the following theorems:
*)

(* We will use the following function to construct a function which compares two nat lists *)
Fixpoint beq_list (T : Type) (l1 l2 : list T) (comp : T -> T -> bool) :=
  match l1 with
  | nil =>
      match l2 with
      | nil => true
      | _ => false
      end
  | e :: l =>
      match l2 with
      | nil => false
      | e' :: l' =>
          match comp e e' with
          | false => false
          | true => beq_list T l l' comp
          end
      end
  end.

Require Import Arith.

Definition beq_nat_list (l1 l2 : list nat) :=
  beq_list nat l1 l2 beq_nat.

Notation "A =l= B" := (beq_nat_list A B) (at level 70, right associativity).

(* We will use the following two functions as examples of predicates which we
* can use to filter elements in or out of lists *)
Fixpoint odd (n : nat) :=
  match n with
    | O => false
    | 1 => true
    | S (S n) => odd n
  end.

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

Definition unit_test_for_filter_in (candidate : (nat -> bool) -> list nat -> list nat) :=
  (candidate (fun _ => true)
             (1 :: 2 :: 3 :: nil) =l= (1 :: 2 :: 3 :: nil))
  &&
  (candidate (fun _ => false)
             (1 :: 2 :: 3 :: nil) =l= nil)
  &&
  (candidate (beq_nat 2)
             (1 :: 2 :: 3 :: nil) =l= (2 :: nil))
  &&
  (candidate even (1 :: 2 :: 3 :: nil) =l= (2 :: nil))
  &&
  (candidate odd (1 :: 2 :: 3 :: nil) =l= (1 :: 3 :: nil)).

Theorem there_is_only_one_filter_in :
  forall (f g : (nat -> bool) -> list nat -> list nat),
    specification_of_filter_in f ->
    specification_of_filter_in g ->
    forall (p : (nat -> bool)) (xs : list nat),
      f p xs = g p xs.
Proof.
  intros f g.
  intros S_f S_g.
  intros p xs.
  unfold specification_of_filter_in in S_f.
  destruct S_f as [H_f_nil [H_f_true H_f_false]].
  unfold specification_of_filter_in in S_g.
  destruct S_g as [H_g_nil [H_g_true H_g_false]].
  induction xs as [ | x xs' IHxs'].
    rewrite -> H_g_nil.
    apply (H_f_nil p).
  case (p x) as [ | ] eqn:H_p.
    rename H_p into H_p_true.
    rewrite -> (H_f_true p x xs' H_p_true).
    rewrite -> (H_g_true p x xs' H_p_true).
    rewrite -> IHxs'.
    reflexivity.
  rename H_p into H_p_false.
  rewrite -> (H_f_false p x xs' H_p_false).
  rewrite -> (H_g_false p x xs' H_p_false).
  apply IHxs'.
Qed.

Fixpoint filter_in_ds (p : nat -> bool) (xs : list nat) :=
  match xs with
  | nil => nil
  | x :: xs' =>
      match p x with
      | true => x :: filter_in_ds p xs'
      | false => filter_in_ds p xs'
      end
  end.

Definition filter_in_v0 (p : nat -> bool) (xs : list nat) :=
  filter_in_ds p xs.

Compute unit_test_for_filter_in filter_in_v0.

Lemma unfold_filter_in_ds_bc :
  forall (p : nat -> bool),
    filter_in_ds p nil = nil.
Proof.
  unfold_tactic filter_in_ds.
Qed.

Lemma unfold_filter_in_ds_ic :
  forall (p : nat -> bool) (x : nat) (xs' : list nat),
    filter_in_ds p (x :: xs') =
      match p x with
      | true => x :: filter_in_ds p xs'
      | false => filter_in_ds p xs'
      end.
Proof.
  unfold_tactic filter_in_ds.
Qed.

Proposition filter_in_v0_fits_the_specification_of_filter_in :
  specification_of_filter_in filter_in_v0.
Proof.
  unfold specification_of_filter_in.
  split.
    intro p.
    unfold filter_in_v0.
    apply (unfold_filter_in_ds_bc p).
  split.
    intros p x xs'.
    intro H_p_true.
    unfold filter_in_v0.
    rewrite -> unfold_filter_in_ds_ic.
    rewrite -> H_p_true.
    reflexivity.
  intros p x xs'.
  intros H_p_false.
  unfold filter_in_v0.
  rewrite -> unfold_filter_in_ds_ic.
  rewrite -> H_p_false.
  reflexivity.
Qed.

(* The following lemma will be handy, because we will be able to use things we
* have proven about filter_in_v0 for any filter_in satisfying the specification *)
Lemma any_filter_in_can_be_rewritten_to_filter_in_v0 :
  forall filter_in : (nat -> bool) -> list nat -> list nat,
    specification_of_filter_in filter_in ->
    forall (p : nat -> bool) (xs : list nat),
      filter_in p xs = filter_in_v0 p xs.
Proof.
  intros filter_in S_filter_in.
  intros p xs.
  rewrite -> (there_is_only_one_filter_in filter_in
                                          filter_in_v0
                                          S_filter_in
                                          filter_in_v0_fits_the_specification_of_filter_in).
  reflexivity.
Qed.

Theorem about_filtering_in_all_of_the_elements :
  forall filter_in : (nat -> bool) -> list nat -> list nat,
    specification_of_filter_in filter_in ->
    forall xs : list nat, (* I renamed this from ns to xs for consistency *)
      filter_in (fun _ => true) xs = xs.
Proof.
  intros filter_in S_filter_in.
  intro xs.
  rewrite -> (any_filter_in_can_be_rewritten_to_filter_in_v0 filter_in
                                                             S_filter_in).
  induction xs as [ | x xs' IHxs'].
    unfold filter_in_v0.
    rewrite -> unfold_filter_in_ds_bc.
    reflexivity.
  unfold filter_in_v0.
  rewrite -> unfold_filter_in_ds_ic.
  unfold filter_in_v0 in IHxs'.
  rewrite -> IHxs'.
  reflexivity.
Qed.

Theorem about_filtering_in_none_of_the_elements :
  forall filter_in : (nat -> bool) -> list nat -> list nat,
    specification_of_filter_in filter_in ->
    forall xs : list nat, (* I renamed this from ns to xs for consistency *)
      filter_in (fun _ => false) xs = nil.
Proof.
  intros filter_in S_filter_in.
  intro xs.
  rewrite -> (any_filter_in_can_be_rewritten_to_filter_in_v0 filter_in
                                                             S_filter_in).
  induction xs as [ | x xs' IHxs'].
    unfold filter_in_v0.
    rewrite unfold_filter_in_ds_bc.
    reflexivity.
  unfold filter_in_v0.
  rewrite -> unfold_filter_in_ds_ic.
  unfold filter_in_v0 in IHxs'.
  apply IHxs'.
Qed.

Theorem about_filtering_in_incrementally :
  forall filter_in : (nat -> bool) -> list nat -> list nat,
    specification_of_filter_in filter_in ->
    forall (p1 p2 : nat -> bool)
           (xs : list nat), (* I renamed this to xs from ns for consistency *)
      filter_in p2 (filter_in p1 xs) =
      filter_in (fun n => andb (p1 n) (p2 n)) xs.
      (* I renamed x to n in the above funtion to avoid automatic naming when
      * doing induction on xs*)
Proof.
  intros filter_in S_filter_in.
  intros p1 p2 xs.
  rewrite ->3 (any_filter_in_can_be_rewritten_to_filter_in_v0 filter_in
                                                              S_filter_in).
  unfold filter_in_v0.
  induction xs as [ | x xs' IHxs' ].
    rewrite -> (unfold_filter_in_ds_bc p1).
    rewrite -> (unfold_filter_in_ds_bc p2).
    rewrite -> unfold_filter_in_ds_bc.
    reflexivity.
  case (p1 x) as [ | ] eqn:H_p1.
    case (p2 x) as [ | ] eqn:H_p2.
      rename H_p1 into H_p1_true.
      rename H_p2 into H_p2_true.
      rewrite -> unfold_filter_in_ds_ic.
      rewrite -> H_p1_true.
      rewrite -> unfold_filter_in_ds_ic.
      rewrite -> H_p2_true.
      rewrite -> IHxs'.
      rewrite -> unfold_filter_in_ds_ic.
      rewrite -> H_p1_true.
      rewrite -> andb_true_l.
      rewrite -> H_p2_true.
      reflexivity.
    rename H_p1 into H_p1_true.
    rename H_p2 into H_p2_false.
    rewrite -> unfold_filter_in_ds_ic.
    rewrite -> H_p1_true.
    rewrite -> unfold_filter_in_ds_ic.
    rewrite -> H_p2_false.
    rewrite -> IHxs'.
    rewrite -> unfold_filter_in_ds_ic.
    rewrite -> H_p1_true.
    rewrite -> andb_true_l.
    rewrite -> H_p2_false.
    reflexivity.
  rename H_p1 into H_p1_false.
  rewrite -> unfold_filter_in_ds_ic.
  rewrite -> H_p1_false.
  rewrite -> IHxs'.
  rewrite -> unfold_filter_in_ds_ic.
  rewrite -> H_p1_false.
  rewrite -> andb_false_l.
  reflexivity.
Qed.

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

(* Here is another specification: *)

Definition specification_of_filter_out (filter_out : (nat -> bool) -> list nat -> list nat) :=
  (forall p : nat -> bool,
     filter_out p nil = nil)
  /\
  (forall (p : nat -> bool)
          (x : nat)
          (xs' : list nat),
     p x = true ->
     filter_out p (x :: xs') = filter_out p xs')
  /\
  (forall (p : nat -> bool)
          (x : nat)
          (xs' : list nat),
     p x = false ->
     filter_out p (x :: xs') = x :: (filter_out p xs')).

(* You are asked to:

   * write unit tests for filter_out;

   * prove whether this definition specifies a unique function;

   * implement a definition of filter_out that satisfies the
     specification;

   * prove properties that are analogue to filter_in; and to

   * prove the two following propositions:
*)

Definition unit_test_for_filter_out (candidate : (nat -> bool) -> list nat -> list nat) :=
  (candidate (fun _ => true)
             (1 :: 2 :: 3 :: nil) =l= nil)
  &&
  (candidate (fun _ => false)
             (1 :: 2 :: 3 :: nil) =l= (1 :: 2 :: 3 :: nil))
  &&
  (candidate (beq_nat 2)
             (1 :: 2 :: 3 :: nil) =l= (1 :: 3 :: nil))
  &&
  (candidate even (1 :: 2 :: 3 :: nil) =l= (1 :: 3 :: nil))
  &&
  (candidate odd (1 :: 2 :: 3 :: nil) =l= (2 :: nil)).

Theorem there_is_only_one_filter_out :
  forall (f g : (nat -> bool) -> list nat -> list nat),
    specification_of_filter_out f ->
    specification_of_filter_out g ->
    forall (p : (nat -> bool)) (xs : list nat),
      f p xs = g p xs.
Proof.
  intros f g.
  intros S_f S_g.
  intros p xs.
  unfold specification_of_filter_out in S_f.
  destruct S_f as [H_f_nil [H_f_true H_f_false]].
  unfold specification_of_filter_out in S_g.
  destruct S_g as [H_g_nil [H_g_true H_g_false]].
  induction xs as [ | x xs' IHxs'].
    rewrite -> (H_f_nil p).
    rewrite -> (H_g_nil p).
    reflexivity.
  case (p x) as [ | ] eqn:H_p.
    rename H_p into H_p_true.
    rewrite -> (H_f_true p x xs' H_p_true).
    rewrite -> (H_g_true p x xs' H_p_true).
    apply IHxs'.
  rename H_p into H_p_false.
  rewrite -> (H_f_false p x xs' H_p_false).
  rewrite -> (H_g_false p x xs' H_p_false).
  rewrite -> IHxs'.
  reflexivity.
Qed.

Fixpoint filter_out_ds (p : nat -> bool) (xs : list nat) :=
  match xs with
  | nil => nil
  | x :: xs' =>
      match p x with
      | true => filter_out_ds p xs'
      | false => x :: filter_out_ds p xs'
      end
  end.

Definition filter_out_v0 (p : nat -> bool) (xs : list nat) :=
  filter_out_ds p xs.

Compute unit_test_for_filter_out filter_out_v0.

Lemma unfold_filter_out_ds_bc :
  forall (p : nat -> bool),
    filter_out_ds p nil = nil.
Proof.
  unfold_tactic filter_out_ds.
Qed.

Lemma unfold_filter_out_ds_ic :
  forall (p : nat -> bool) (x : nat) (xs' : list nat),
    filter_out_ds p (x :: xs') =
      match p x with
      | true => filter_out_ds p xs'
      | false => x :: filter_out_ds p xs'
      end.
Proof.
  unfold_tactic filter_out_ds.
Qed.

Proposition filter_out_v0_fits_the_specification_of_filter_out :
  specification_of_filter_out filter_out_v0.
Proof.
  unfold specification_of_filter_out.
  split.
    intro p.
    unfold filter_out_v0.
    apply (unfold_filter_out_ds_bc p).
  split.
    intros p x xs'.
    intros H_p_true.
    unfold filter_out_v0.
    rewrite -> unfold_filter_out_ds_ic.
    rewrite -> H_p_true.
    reflexivity.
  intros p x xs'.
  intro H_p_false.
  unfold filter_out_v0.
  rewrite -> unfold_filter_out_ds_ic.
  rewrite -> H_p_false.
  reflexivity.
Qed.

Lemma any_filter_out_can_be_rewritten_to_filter_out_v0 :
  forall filter_out : (nat -> bool) -> list nat -> list nat,
    specification_of_filter_out filter_out ->
    forall (p : nat -> bool) (xs : list nat),
      filter_out p xs = filter_out_v0 p xs.
Proof.
  intros filter_out S_filter_out.
  intros p xs.
  rewrite -> (there_is_only_one_filter_out filter_out
                                           filter_out_v0
                                           S_filter_out
                                           filter_out_v0_fits_the_specification_of_filter_out).
  reflexivity.
Qed.

Theorem about_filtering_out_all_of_the_elements :
  forall filter_out : (nat -> bool) -> list nat -> list nat,
    specification_of_filter_out filter_out ->
    forall xs : list nat,
      filter_out (fun _ => true) xs = nil.
Proof.
  intros filter_out S_filter_out.
  intro xs.
  rewrite -> (any_filter_out_can_be_rewritten_to_filter_out_v0 filter_out
                                                               S_filter_out).
  induction xs as [ | x xs' IHxs'].
    unfold filter_out_v0.
    rewrite -> unfold_filter_out_ds_bc.
    reflexivity.
  unfold filter_out_v0.
  rewrite -> unfold_filter_out_ds_ic.
  unfold filter_out_v0 in IHxs'.
  apply IHxs'.
Qed.

Theorem about_filtering_out_none_of_the_elements :
  forall filter_out : (nat -> bool) -> list nat -> list nat,
    specification_of_filter_out filter_out ->
    forall xs : list nat,
      filter_out (fun _ => false) xs = xs.
Proof.
  intros filter_out S_filter_out.
  intro xs.
  rewrite -> (any_filter_out_can_be_rewritten_to_filter_out_v0 filter_out
                                                               S_filter_out).
  induction xs as [ | x xs' IHxs'].
    unfold filter_out_v0.
    rewrite unfold_filter_out_ds_bc.
    reflexivity.
  unfold filter_out_v0.
  rewrite unfold_filter_out_ds_ic.
  unfold filter_out_v0 in IHxs'.
  rewrite -> IHxs'.
  reflexivity.
Qed.

Theorem about_filtering_out_incrementally :
  forall filter_out : (nat -> bool) -> list nat -> list nat,
    specification_of_filter_out filter_out ->
    forall (p1 p2 : nat -> bool)
           (xs : list nat),
      filter_out p2 (filter_out p1 xs) =
      filter_out (fun n => orb (p1 n) (p2 n)) xs.
Proof.
  intros filter_out S_filter_out.
  intros p1 p2 xs.
  rewrite ->3 (any_filter_out_can_be_rewritten_to_filter_out_v0 filter_out
                                                                S_filter_out).
  unfold filter_out_v0.
  induction xs as [ | x xs' IHxs' ].
    rewrite -> (unfold_filter_out_ds_bc p1).
    rewrite -> (unfold_filter_out_ds_bc p2).
    rewrite -> unfold_filter_out_ds_bc.
    reflexivity.
  case (p1 x) as [ | ] eqn:H_p1.
    case (p2 x) as [ | ] eqn:H_p2.
      rename H_p1 into H_p1_true.
      rename H_p2 into H_p2_true.
      rewrite -> unfold_filter_out_ds_ic.
      rewrite -> H_p1_true.
      rewrite -> unfold_filter_out_ds_ic.
      rewrite -> H_p1_true.
      rewrite -> orb_true_l.
      apply IHxs'.
    rename H_p1 into H_p1_true.
    rename H_p2 into H_p2_false.
    rewrite -> unfold_filter_out_ds_ic.
    rewrite -> H_p1_true.
    rewrite -> unfold_filter_out_ds_ic.
    rewrite -> H_p1_true.
    rewrite -> orb_true_l.
    apply IHxs'.
  rename H_p1 into H_p1_false.
  case (p2 x) as [ | ] eqn:H_p2.
    rename H_p2 into H_p2_true.
    rewrite -> unfold_filter_out_ds_ic.
    rewrite -> H_p1_false.
    rewrite -> unfold_filter_out_ds_ic.
    rewrite -> H_p2_true.
    rewrite -> IHxs'.
    rewrite -> unfold_filter_out_ds_ic.
    rewrite -> H_p2_true.
    rewrite -> orb_true_r.
    reflexivity.
  rename H_p2 into H_p2_false.
  rewrite -> unfold_filter_out_ds_ic.
  rewrite -> H_p1_false.
  rewrite -> unfold_filter_out_ds_ic.
  rewrite -> H_p2_false.
  rewrite -> IHxs'.
  rewrite -> unfold_filter_out_ds_ic.
  rewrite -> H_p1_false.
  rewrite -> orb_false_l.
  rewrite -> H_p2_false.
  reflexivity.
Qed.

Proposition filter_out_from_filter_in :
  forall filter_in : (nat -> bool) -> list nat -> list nat,
    specification_of_filter_in filter_in ->
    specification_of_filter_out (fun p ns => filter_in (fun n => negb (p n)) ns).
    (* Renamed x to n in the above innermost function to avoid automatic naming *)
Proof.
  intros filter_in S_filter_in.
  unfold specification_of_filter_out.
  split.
    intro p.
    rewrite -> (any_filter_in_can_be_rewritten_to_filter_in_v0 filter_in
                                                               S_filter_in).
    unfold filter_in_v0.
    apply unfold_filter_in_ds_bc.
  split.
    intros p x xs'.
    intro H_p_true.
    rewrite ->2 (any_filter_in_can_be_rewritten_to_filter_in_v0 filter_in
                                                                S_filter_in).
    unfold filter_in_v0.
    rewrite -> unfold_filter_in_ds_ic.
    rewrite -> H_p_true.
    rewrite -> unfold_negb_base_case_true.
    reflexivity.
  intros p x xs'.
  intro H_p_false.
  rewrite ->2 (any_filter_in_can_be_rewritten_to_filter_in_v0 filter_in
                                                              S_filter_in).
  unfold filter_in_v0.
  rewrite -> unfold_filter_in_ds_ic.
  rewrite -> H_p_false.
  rewrite -> unfold_negb_base_case_false.
  reflexivity.
Qed.

Proposition filter_in_from_filter_out :
  forall filter_out : (nat -> bool) -> list nat -> list nat,
    specification_of_filter_out filter_out ->
    specification_of_filter_in (fun p ns => filter_out (fun n => negb (p n)) ns).
Proof.
  intros filter_out S_filter_out.
  unfold specification_of_filter_in.
  split.
    intro p.
    rewrite -> (any_filter_out_can_be_rewritten_to_filter_out_v0 filter_out
                                                                 S_filter_out).
    unfold filter_out_v0.
    apply unfold_filter_out_ds_bc.
  split.
    intros p x xs'.
    intro H_p_true.
    rewrite ->2 (any_filter_out_can_be_rewritten_to_filter_out_v0 filter_out
                                                                  S_filter_out).
    unfold filter_out_v0.
    rewrite -> unfold_filter_out_ds_ic.
    rewrite -> H_p_true.
    rewrite -> unfold_negb_base_case_true.
    reflexivity.
  intros p x xs'.
  intro H_p_false.
  rewrite ->2 (any_filter_out_can_be_rewritten_to_filter_out_v0 filter_out
                                                                S_filter_out).
  unfold filter_out_v0.
  rewrite -> unfold_filter_out_ds_ic.
  rewrite -> H_p_false.
  rewrite -> unfold_negb_base_case_false.
  reflexivity.
Qed.

(* Which consequences of these propositions can you think of? *)

(* We can define filter_out using filter_in *)
Definition filter_out_v1 (p : nat -> bool) (xs : list nat) :=
  filter_in_v0 (fun n => negb (p n)) xs.

Compute unit_test_for_filter_out filter_out_v1.

Proposition filter_out_v1_fits_the_specification_of_filter_out :
  specification_of_filter_out filter_out_v1.
Proof.
  unfold specification_of_filter_out.
  split.
    intro p.
    unfold filter_out_v1.
    unfold filter_in_v0.
    apply unfold_filter_in_ds_bc.
  split.
    intros p x xs'.
    intro H_p_true.
    unfold filter_out_v1.
    unfold filter_in_v0.
    rewrite -> unfold_filter_in_ds_ic.
    rewrite -> H_p_true.
    rewrite -> unfold_negb_base_case_true.
    reflexivity.
  intros p x xs'.
  intro H_p_false.
  unfold filter_out_v1.
  unfold filter_in_v0.
  rewrite -> unfold_filter_in_ds_ic.
  rewrite -> H_p_false.
  rewrite -> unfold_negb_base_case_false.
  reflexivity.
Qed.

Lemma any_filter_out_can_be_rewritten_to_filter_out_v1 :
  forall filter_out : (nat -> bool) -> list nat -> list nat,
    specification_of_filter_out filter_out ->
    forall (p : nat -> bool) (xs : list nat),
      filter_out p xs = filter_out_v1 p xs.
Proof.
  intros filter_out S_filter_out.
  intros p xs.
  rewrite -> (there_is_only_one_filter_out filter_out
                                           filter_out_v1
                                           S_filter_out
                                           filter_out_v1_fits_the_specification_of_filter_out).
  reflexivity.
Qed.

(* We can define filter_in using filter_out *)
Definition filter_in_v1 (p : nat -> bool) (xs : list nat) :=
  filter_out_v0 (fun n => negb (p n)) xs.

Compute unit_test_for_filter_in filter_in_v1.

Proposition filter_in_v1_fits_the_specification_of_filter_in :
  specification_of_filter_in filter_in_v1.
Proof.
  unfold specification_of_filter_in.
  split.
    intro p.
    unfold filter_in_v1.
    unfold filter_out_v0.
    apply unfold_filter_out_ds_bc.
  split.
    intros p x xs'.
    intro H_p_true.
    unfold filter_in_v1.
    unfold filter_out_v0.
    rewrite -> unfold_filter_out_ds_ic.
    rewrite -> H_p_true.
    rewrite -> unfold_negb_base_case_true.
    reflexivity.
  intros p x xs'.
  intro H_p_false.
  unfold filter_in_v1.
  unfold filter_out_v0.
  rewrite -> unfold_filter_out_ds_ic.
  rewrite -> H_p_false.
  rewrite -> unfold_negb_base_case_false.
  reflexivity.
Qed.

Lemma any_filter_in_can_be_rewritten_to_filter_in_v1 :
  forall filter_in : (nat -> bool) -> list nat -> list nat,
    specification_of_filter_in filter_in ->
    forall (p : nat -> bool) (xs : list nat),
      filter_in p xs = filter_in_v1 p xs.
Proof.
  intros filter_in S_filter_in.
  intros p xs.
  rewrite -> (there_is_only_one_filter_in filter_in
                                          filter_in_v1
                                          S_filter_in
                                          filter_in_v1_fits_the_specification_of_filter_in).
  reflexivity.
Qed.

(* Using the two propositions above we could have proven filter_out theorems
* using the filter_in_ds unfold lemmas and vice versa. Let's try to do that in
* the following proofs. *)

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

(* What is the result

   * of applying filter_in to the concatenation of two lists?

   * of applying filter_out to the concatenation of two lists?

   * of applying filter_in to a reversed list?

   * of applying filter_out to a reversed list?
*)

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

(* We will answer the above questions with four theorems and their proofs *)

(* We will need the following two lemmas for the following theorems *)

Lemma unfold_append_bc :
  forall (xs : list nat),
    nil ++ xs = xs.
Proof.
  apply app_nil_l.
Qed.

Lemma unfold_append_ic :
  forall (x : nat) (xs1' xs2 : list nat),
    (x :: xs1') ++ xs2 = x :: (xs1' ++ xs2).
Proof.
  intros x xs1' xs2.
  symmetry.
  apply app_comm_cons.
Qed.

Theorem about_filter_in_and_concatenation_of_lists :
  forall (filter_in : (nat -> bool) -> list nat -> list nat),
    specification_of_filter_in filter_in ->
    forall (p : nat -> bool) (xs1 xs2 : list nat),
      filter_in p (xs1 ++ xs2) = filter_in p xs1 ++ filter_in p xs2.
Proof.
  intros filter_in S_filter_in.
  intros p xs1 xs2.
  rewrite ->3 (any_filter_in_can_be_rewritten_to_filter_in_v0 filter_in
                                                              S_filter_in).
  unfold filter_in_v0.
  induction xs1 as [ | x xs1' IHxs1'].
    rewrite -> unfold_append_bc.
    rewrite -> unfold_filter_in_ds_bc.
    rewrite -> unfold_append_bc.
    reflexivity.
  rewrite -> unfold_append_ic.
  case (p x) as [ | ] eqn:H_p.
    rename H_p into H_p_true.
    rewrite -> unfold_filter_in_ds_ic.
    rewrite -> H_p_true.
    rewrite -> IHxs1'.
    rewrite -> unfold_filter_in_ds_ic.
    rewrite -> H_p_true.
    rewrite -> unfold_append_ic.
    reflexivity.
  rename H_p into H_p_false.
  rewrite -> unfold_filter_in_ds_ic.
  rewrite -> H_p_false.
  rewrite -> IHxs1'.
  rewrite -> unfold_filter_in_ds_ic.
  rewrite -> H_p_false.
  reflexivity.
Qed.

Theorem about_filter_out_and_concatenation_of_lists :
  forall (filter_out : (nat -> bool) -> list nat -> list nat),
    specification_of_filter_out filter_out ->
    forall (p : nat -> bool) (xs1 xs2 : list nat),
      filter_out p (xs1 ++ xs2) = filter_out p xs1 ++ filter_out p xs2.
Proof.
  intros filter_out S_filter_out.
  intros p xs1 xs2.
  rewrite ->3 (any_filter_out_can_be_rewritten_to_filter_out_v0 filter_out S_filter_out).
  unfold filter_out_v0.
  induction xs1 as [ | x xs1' IHxs1'].
    rewrite -> unfold_append_bc.
    rewrite -> unfold_filter_out_ds_bc.
    rewrite -> unfold_append_bc.
    reflexivity.
  rewrite -> unfold_append_ic.
  case (p x) as [ | ] eqn:H_p.
    rename H_p into H_p_true.
    rewrite -> unfold_filter_out_ds_ic.
    rewrite -> H_p_true.
    rewrite -> IHxs1'.
    rewrite -> unfold_filter_out_ds_ic.
    rewrite -> H_p_true.
    reflexivity.
  rename H_p into H_p_false.
  rewrite -> unfold_filter_out_ds_ic.
  rewrite -> H_p_false.
  rewrite -> IHxs1'.
  rewrite -> unfold_filter_out_ds_ic.
  rewrite -> H_p_false.
  reflexivity.
  Show Proof.

  Restart.
  (* or proven by the help of the connection between filter_in and filter_out *)
  intros filter_out S_filter_out.
  intros p xs1 xs2.
  rewrite ->3 (any_filter_out_can_be_rewritten_to_filter_out_v1 filter_out
                                                                S_filter_out).
  unfold filter_out_v1.
  assert (S_filter_in_v0 := filter_in_v0_fits_the_specification_of_filter_in).
  apply (about_filter_in_and_concatenation_of_lists filter_in_v0
                                                    S_filter_in_v0
                                                    (fun n : nat => negb (p n))
                                                    xs1 xs2).
Qed.

(* We will need the following two lemmas for proving the following two theorems *)
Lemma unfold_reverse_bc :
  forall (T : Type),
    rev nil = (nil : list T).
Proof.
  unfold_tactic rev.
Qed.

Lemma unfold_reverse_ic :
  forall (T : Type) (x : T) (xs : list T),
    rev (x :: xs) = rev xs ++ x :: nil.
Proof.
  unfold_tactic rev.
Qed.

Theorem about_filter_in_and_reverse_list :
  forall (filter_in : (nat -> bool) -> list nat -> list nat),
    specification_of_filter_in filter_in ->
    forall (p : nat -> bool) (xs : list nat),
      filter_in p (rev xs) = rev (filter_in p xs).
Proof.
  intros filter_in S_filter_in.
  intros p xs.
  induction xs as [ | x xs' IHxs'].
    rewrite ->2 (any_filter_in_can_be_rewritten_to_filter_in_v0 filter_in
                                                                S_filter_in).
    unfold filter_in_v0.
    rewrite -> unfold_reverse_bc.
    rewrite -> unfold_filter_in_ds_bc.
    rewrite -> unfold_reverse_bc.
    reflexivity.
  rewrite -> unfold_reverse_ic.
  case (p x) as [ | ] eqn:H_p.
    rename H_p into H_p_true.
    rewrite -> (about_filter_in_and_concatenation_of_lists filter_in
                                                           S_filter_in
                                                           p (rev xs') (x :: nil)).
    rewrite -> IHxs'.
    rewrite ->3 (any_filter_in_can_be_rewritten_to_filter_in_v0 filter_in
                                                                S_filter_in).
    unfold filter_in_v0.
    rewrite -> unfold_filter_in_ds_ic.
    rewrite -> H_p_true.
    rewrite -> unfold_filter_in_ds_bc.
    rewrite -> unfold_filter_in_ds_ic.
    rewrite -> H_p_true.
    rewrite -> unfold_reverse_ic.
    reflexivity.
  rename H_p into H_p_false.
  rewrite -> (about_filter_in_and_concatenation_of_lists filter_in
                                                         S_filter_in
                                                         p (rev xs') (x :: nil)).
  rewrite -> IHxs'.
  rewrite ->3 (any_filter_in_can_be_rewritten_to_filter_in_v0 filter_in
                                                              S_filter_in).
  unfold filter_in_v0.
  rewrite -> unfold_filter_in_ds_ic.
  rewrite -> H_p_false.
  rewrite -> unfold_filter_in_ds_bc.
  rewrite -> app_nil_r.
  rewrite -> unfold_filter_in_ds_ic.
  rewrite -> H_p_false.
  reflexivity.
Qed.

Theorem about_filter_out_and_reverse_list :
  forall (filter_out : (nat -> bool) -> list nat -> list nat),
    specification_of_filter_out filter_out ->
    forall (p : nat -> bool) (xs : list nat),
      filter_out p (rev xs) = rev (filter_out p xs).
Proof.
  intros filter_out S_filter_out.
  intros p xs.
  rewrite ->2 (any_filter_out_can_be_rewritten_to_filter_out_v1 filter_out
                                                                S_filter_out).
  unfold filter_out_v1.
  assert (S_filter_in_v0 := filter_in_v0_fits_the_specification_of_filter_in).
  apply (about_filter_in_and_reverse_list filter_in_v0
                                          S_filter_in_v0
                                          (fun n : nat => negb (p n))
                                          xs).
Qed.

Theorem ben :
  forall b : bool,
    orb b (negb b) = true.
Proof.
  intros [ | ].
  apply orb_true_l.
  rewrite -> orb_false_l.
  apply unfold_negb_base_case_false.
Qed.

(* end of filtering_lists.v *)


Require Import Cpdt.CpdtTactics.
Require Import Arith.

Set Implicit Arguments.

(* 1 *)
(* 1.1 Explicit definition *)
Fixpoint le_nat_dec (n m : nat) : { n <= m } + { n > m } :=
  match n with
  | O => left (le_O_n m)
  | S n' => match m with
      | O => right (gt_Sn_O n')
      | S m' => match le_nat_dec n' m' with
          | left p => left (le_n_S n' m' p)
          | right p => right (gt_n_S n' m' p)
          end
      end
  end.
Check le_nat_dec.
Extraction le_nat_dec.
(*
Notation "'Yes'" := (left _ _).
Notation "'No'" := (right _ _).
Notation "'Reduce' x" := (if x then Yes else No) (at level 50, only parsing).

(* 1.2 Definition using refine *)
Definition le_nat_dec' : forall n m : nat, { n <= m } + { n > m }.
  refine (fix f n m :=
    match n with
    | O => Yes
    | S n' => match m with
        | O => No
        | S m' => Reduce (f n' m')
        end
    end
  ); crush.
Defined.
Check le_nat_dec'.
Extraction le_nat_dec.
*)
(* 2 *)
Require Import Bool.

Definition var := nat.

Inductive prop : Type :=
  | Var : var -> prop
  | Neg : prop -> prop
  | Conj : prop -> prop -> prop
  | Disj : prop -> prop -> prop.

Definition truthVar := var -> bool.

Fixpoint propDenote (t : truthVar) (p : prop) {struct p} : Prop :=
  match p with
  | Var v => if t v then True else False
  | Neg p => ~ propDenote t p
  | Conj a b => propDenote t a /\ propDenote t b
  | Disj a b => propDenote t a \/ propDenote t b
  end.
Print left.

(* semi-implicit construction *)
Definition bool_true_dec : forall b : bool, {b = true} + {b = true -> False}.
  refine (fix f b := match b with
    | true => left _ _
    | false => right _ _
    end
  ); crush.
Defined.

(* explicit construction *)
Definition bool_true_dec' (b : bool) : {b = true} + {b = true -> False} :=
  match b with
  | true => left (eq_refl true)
  | false => right (fun H => diff_false_true H)
  end.
Print left.

(* CRUCIAL thing for automation with crush *)
Hint Unfold not. (* Most important line *)
(* Do not delete previous line *)

(* TACTICAL construction *)
Definition decide : forall truth pr, {propDenote truth pr} + {~ propDenote truth pr}.
  intros. induction pr.
  simpl; destruct (truth v); crush.
  simpl; destruct IHpr; crush.
  simpl; destruct IHpr1, IHpr2; crush.
  simpl; destruct IHpr1, IHpr2; crush.
Defined.

(* REFINE construction (tried to make more explicit than i possibly should) *)
Definition decide' : forall truth pr, {propDenote truth pr} + {~ propDenote truth pr}.
  refine (fix d t p {struct p} :=
    match p return {propDenote t p} + {~ propDenote t p} with
    | Var v => match bool_true_dec (t v) with
        | left e => left _
        | right e => right _
        end
    | Neg b => match d t b with
        | left e => right _
        | right e => left _
        end
    | Conj a b => match (d t a, d t b) with
        | (left pa, left pb) => left (conj pa pb)
        | (_, _) => right _
        end
    | Disj a b => match (d t a, d t b) with
        | (left pa, _) => left (or_introl pa)
        | (_, left pb) => left (or_intror pb)
        | (right _, right _) => right _
        end
    end
  ); crush; destruct (t v); crush. (* destruct for 'right' case of 'Var' *)
Defined.

Definition negate : forall p : prop,
    { p' : prop | forall truth, propDenote truth p <-> ~ propDenote truth p' }.
Print sig.
  refine (fix n p :=
    match p with
    | Var v => exist _ (Neg (Var v)) _
    | Neg p => exist _ p _
    | Conj a b => exist _ (Disj (proj1_sig (n a)) (proj1_sig (n b))) _
    | Disj a b => exist _ (Conj (proj1_sig (n a)) (proj1_sig (n b))) _
    end
  ).
    intro t; crush; destruct (t v); crush.
    intro t; crush; simpl.
    destruct (n a), (n b); crush.
      apply i in H1; assumption.
      apply i0 in H2; assumption.
    destruct (n a), (n b); crush.
      apply i in H0; assumption.
      apply i0 in H0; assumption.
    destruct (decide truth x), (decide truth x0); crush.
Defined.

Eval compute in proj1_sig (negate (Conj (Neg (Var 1)) (Neg (Var 2)))).

(* DPLL in file DPLL.v *)


(* Script Coq pour le Thème 7 : types inductifs *)

Require Import Arith.
Require Import List.

(*---------------------------------------------------------------*)
(** * Types énumérés *)

Print bool.

Inductive Couleur : Set :=
 | pique : Couleur
 | coeur : Couleur
 | carreau : Couleur
 | trefle : Couleur.

Fixpoint valeur_couleur (c:Couleur) : nat :=
  match c with
  | pique => 1
  | coeur => 2
  | carreau => 3
  | trefle => 4
  end.

Example ex_valeur_couleur1: valeur_couleur coeur = 2.
Proof.
  compute. reflexivity.
Qed.

Check Couleur_ind.

Lemma couleur_surj:
  forall c : Couleur,
    c = pique \/ c = coeur \/ c = carreau \/ c = trefle.
Proof.
  destruct c. (* essayer aussi avec induction c *)
  - (* cas pique *)
    left.
    reflexivity.
  - (* cas coeur *)
    right.
    left.
    reflexivity.
  - (* cas carreau *)
    right. right.
    left.
    reflexivity.
  - (* cas trefle *)
    right. right. right.
    reflexivity.
Qed.

(** ** Exercice *)

Lemma borne_valeur:
  forall c : Couleur,
    (0 < (valeur_couleur c)) /\ ((valeur_couleur c) <= 4).
Proof.
  destruct c.
  - simpl.
   split.
   SearchPattern ( 0 < _ ).
   apply lt_0_Sn.
   SearchPattern ( _ <= _ ).
   apply le_n_S.
   SearchPattern ( 0 <= _ ).
   apply le_0_n.
  -simpl; auto with arith.
  -simpl; auto with arith.
  -simpl; auto with arith.
Qed.

(*---------------------------------------------------------------*)
(** * Types paramétrés *)

Inductive geom : Set :=
  | point: nat -> nat -> geom
  | segment: nat -> nat -> nat -> nat -> geom
  | triangle: nat -> nat -> nat -> nat -> nat -> nat -> geom
  | nogeom : geom.

Fixpoint compose_geom (g1 g2:geom) : geom :=
  match g1 with
  | point x1 y1 => match g2 with
                   | point x2 y2 => segment x1 y1 x2 y2
                   | segment x2 y2 x3 y3 => triangle x1 y1 x2 y2 x3 y3
                   | _ => nogeom
                   end
  | segment x1 y1 x2 y2 => match g2 with
                   | point x3 y3 => triangle x1 y1 x2 y2 x3 y3
                   | _ => nogeom
                   end
  | _ => nogeom
  end.

Example ex_segment: compose_geom (point 0 0) (point 1 1) =
  segment 0 0 1 1.
Proof.
  compute. reflexivity.
Qed.

Check geom_ind.

(** ** Exercice *)

Lemma compose_nogeom:
  forall g : geom, compose_geom nogeom g = nogeom.
Proof.
  intro geom.
simpl.
reflexivity.
Qed.
(*---------------------------------------------------------------*)
(** * Types polymorphes *)

Inductive maybe (A:Set) : Type :=
  Nothing : maybe A
| Just : A -> maybe A.

Arguments Nothing [A].
Arguments Just [A] _.

Check maybe_ind.

Definition maybe_map {A B:Set} (f:A->B) : maybe A -> maybe B :=
  fun (ma:maybe A) => match ma with
                        | Nothing => Nothing
                        | Just a => Just (f a)
                      end.

Lemma maybe_map_id:
  forall A : Set, forall ma : maybe A,
    maybe_map (fun a:A => a) ma = (fun (ma:maybe A) => ma) ma.
Proof.
  intros A ma.
  unfold maybe_map.
  destruct ma as [|a].
  reflexivity.
  reflexivity.
Qed.

(** ** Exercice *)

Definition maybe_compose {A B C : Set} (f:A->B) (g:B->C) : A->C :=
  fun (a:A) => g (f a).

Lemma maybe_map_compose:
  forall A B C : Set, forall ma : maybe A,
  forall f : A->B, forall g: B->C,
    maybe_map (maybe_compose f g) ma
    = (maybe_compose (maybe_map f) (maybe_map g)) ma.
Proof.
  intros A B C ma f g.
  compute.
  destruct ma as [|a].
  reflexivity.
  reflexivity.
Qed.
  (*---------------------------------------------------------------*)
(** * Types récursifs simples *)

Check nat_ind.

Inductive list_Couleur : Set :=
  | Nil_Couleur: list_Couleur
  | Cons_Couleur: Couleur -> list_Couleur -> list_Couleur.

(* Ecrire ci-dessous le principe d'induction. *)

(*list_Couleur_ind : forall P : list_Couleur -> Prop,
                     P Nil_Couleur ->
                     (forall (c:Couleur l:list_Couleur), P l -> (Cons_Couleur c l)) ->
                     forall l : list_Couleur, P l.
*)
(* Et pour vérifier votre solution ... *)
Check list_Couleur_ind.

(** ** Exercice *)

Fixpoint meme_couleur (c : Couleur) (l : list_Couleur) : Prop :=
  match l with
    | Nil_Couleur => True
    | Cons_Couleur e l' => (e = c) /\ meme_couleur c l'
  end.

Fixpoint somme_couleurs (l : list_Couleur) : nat :=
  match l with
    | Nil_Couleur => 0
    | Cons_Couleur e l' => (valeur_couleur e) + (somme_couleurs l')
  end.

Fixpoint longueur (l : list_Couleur) : nat :=
  match l with
    | Nil_Couleur => 0
    | Cons_Couleur _ l' => S (longueur l')
  end.

Lemma couleur_unique:
  forall c : Couleur, forall l : list_Couleur,
    meme_couleur c l
    -> (somme_couleurs l) = (longueur l) * (valeur_couleur c).
Proof.
  intros c l.
  induction l as [|c' cl'].
    - simpl.
      intro.
      reflexivity.
    - simpl.
      intros cc.
      destruct cc as [H1 H2].
      rewrite H1.
      rewrite IHcl'.
      + reflexivity.
      + exact H2.
Qed.
(*---------------------------------------------------------------*)
(** * Types récursifs polymorphes *)

Print list.

Check list_ind.

(** ** Exercice *)

(** *** Question 1 *)
Inductive bintree (A:Set) : Set :=
leaf : bintree A
| node : A -> bintree A -> bintree A -> bintree A.

Arguments leaf [A].
Arguments node [A] _ _ _.

Check bintree_ind.

(** *** Question 2 *)

Fixpoint nsize {A:Set} (t : bintree A) : nat :=
  match t with
    | leaf => 0
    | node _ g d => 1 + nsize g + nsize d
  end.

Definition bintree_ex1 : bintree nat :=
  (node 1
        (node 2
              (node 3 leaf leaf)
              (node 4
                    (node 5 leaf leaf)
                    (node 6 leaf (node 7 leaf leaf))))
        (node 8
              (node 9 leaf leaf)
              leaf)).

Example nsize_ex1:
  nsize bintree_ex1 = 9.
Proof.
  compute. reflexivity.
Qed.

(** *** Question 3 *)

Fixpoint lsize {A:Set} (t : bintree A) : nat :=
  match t with
    | leaf => 1
    | node _ g d => lsize g + lsize d
  end.

Example lsize_ex1:
  lsize bintree_ex1 = 10.
Proof.
  compute. reflexivity.
Qed.

Lemma node_leaf_size:
  forall A : Set, forall t : bintree A,
    (lsize t) = S (nsize t).
Proof.
  intros A t.
  induction t as [| g d].
  + simpl.
    reflexivity.
  +simpl.
   rewrite IHd.
   rewrite IHt1.
   SearchRewrite( S (_)).
   simpl.
   rewrite <- plus_n_Sm.
   reflexivity.
Qed.
(** ** Exercice *)

(** *** Question 1 *)

Fixpoint lprefix {A: Set} (t : bintree A) : list A :=
  match t with
    | leaf => nil
    | node a g d => ((a :: (lprefix g)) ++ lprefix d)
                      end.

Example lprefix_ex1:
  lprefix bintree_ex1 = 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: nil.
Proof.
  compute. reflexivity.
Qed.

(** *** Question 2 *)

Lemma nsize_length:
  forall A : Set, forall t : bintree A,
    nsize t = length (lprefix t).
Proof.
  intros A t.
  induction t as [| l n].
  -simpl.
   reflexivity.
  -simpl.
   rewrite IHn.
   rewrite IHt1.
   SearchRewrite ( length _ ).
   rewrite app_length.
   reflexivity.
Qed.

(** ** Exercice *)

(** *** Question 1 *)

Fixpoint bmap {A B: Set} (f : A -> B) (t : bintree A) : bintree B :=
  match t with
    | leaf => leaf
    | node a g d => node (f a) (bmap f g) (bmap f d)
  end.

Example bmap_ex1:
  bmap (fun (n:nat) =>  n + n) bintree_ex1
  = node 2
         (node 4
               (node 6 leaf leaf)
               (node 8
                     (node 10 leaf leaf)
                     (node 12 leaf (node 14 leaf leaf))))
         (node 16 (node 18 leaf leaf) leaf).
Proof.
  compute. reflexivity.
Qed.

(** *** Question 2 *)

Lemma map_bmap:
  forall A B : Set,
  forall f : A->B, forall t : bintree A,
    lprefix (bmap f t) = map f (lprefix t).
Proof.
  intros A B f t.
  induction t as [| l n].
  -simpl.
   reflexivity.
  -simpl.
   rewrite IHn.
   rewrite IHt1.
   SearchRewrite( _ ++ _ ).
   rewrite map_app.
   reflexivity.
Qed.
(*---------------------------------------------------------------*)
(** * Récursion mutuelle *)

Inductive gentree (A:Set) : Set :=
| gnode: A -> forest A -> gentree A
with forest (A:Set) : Set :=
| fnil: forest A
| fcons: gentree A -> forest A -> forest A.

Arguments gnode [A] _ _.
Arguments fnil [A].
Arguments fcons [A] _ _.

Check gentree_ind.

Check forest_ind.

Fixpoint gsize {A:Set} (t:gentree A) : nat :=
  match t with
    | gnode _ f => S (fsize f)
  end
with fsize {A:Set} (f:forest A) : nat :=
       match f with
         | fnil => 0
         | fcons e f' => (gsize e) + (fsize f')
       end.

Fixpoint lgprefix {A:Set} (t:gentree A) : list A :=
  match t with
    | gnode e f => e::(lfprefix f)
  end
with lfprefix {A:Set} (f:forest A) : list A :=
    match f with
      | fnil => nil
      | fcons e f' => (lgprefix e) ++ (lfprefix f')
    end.

Lemma gsize_length:
  forall A : Set, forall t : gentree A,
    gsize t = length (lgprefix t).
Proof.
  intros A t.
  induction t.
  simpl.
Abort.

Scheme gentree_ind' :=
  Induction for gentree Sort Prop
  with forest_ind' :=
    Induction for forest Sort Prop.

Check gentree_ind'.

Lemma gsize_length:
  forall A : Set, forall t : gentree A,
    gsize t = length (lgprefix t).
Proof.
  intros A t.
  elim t using gentree_ind' with
  (P0:= fun f:forest A => fsize f = length (lfprefix f)).
  - (* cas des noeuds *)
    intros a f H1.
    simpl.
    rewrite H1.
    reflexivity.
  - (* cas des forêts vides *)
    simpl.
    reflexivity.
  - (* cas des forêts non-vides *)
    intros g Hg f Hf.
    simpl.
    rewrite Hg.
    rewrite Hf.
    (* SearchRewrite (length (_ ++ _))
       app_length:
         forall (A : Type) (l l' : list A),
             length (l ++ l') = length l + length l' *)
    rewrite app_length.
    reflexivity.
Qed.

(** ** Exercice *)

(** *** Question 1 *)

Fixpoint gmap {A B:Set} (fn : A -> B) (t:gentree A) : gentree B :=
  match t with
    | gnode e f => gnode (fn e) (fmap fn f)
  end
with fmap {A B:Set} (fn : A -> B) (f:forest A) : forest B :=
    match f with
      | fnil => fnil
      | fcons e f' => fcons (gmap fn e) (fmap fn f')
    end.

(** *** Question 2 *)

Lemma map_gmap:
  forall A B : Set,
  forall h : A->B, forall t : gentree A,
    lgprefix (gmap h t) = map h (lgprefix t).
Proof.
  intros A B h t.
  elim t using gentree_ind' with
  (P0:= fun f : forest A => lfprefix (fmap h f) = map h (lfprefix f)).
  -intros a f H1.
   simpl.
   rewrite H1.
   reflexivity.
  -simpl.
   reflexivity.
  -intros g Hg f Hf.
   simpl.
   rewrite Hg.
   rewrite Hf.
   SearchRewrite(map _ (_ ++ _)).
   rewrite map_app.
   reflexivity.
Qed.

(*---------------------------------------------------------------*)
(** * Types dépendants *)

Inductive domino : nat -> nat -> Type :=
  | block: forall m n, domino m n
  | chain: forall m n p, domino m n -> domino n p -> domino m p.

Arguments chain [m n p] _ _.

Eval compute in (chain (chain (block 3 8) (block 8 4)) (block 4 9)).

Inductive vector (A:Set) : nat -> Set :=
  | vNil : vector A O
  | vCons : forall n, A -> vector A n -> vector A (S n).

Arguments vNil [A].
Arguments vCons [A][n] _ _.

Check vector_ind.

Fixpoint vapp {A:Set} {n1:nat} (v1:vector A n1) {n2:nat} (v2:vector A n2) : vector A (n1 + n2) :=
  match v1 in (vector _ n1) return (vector A (n1 + n2)) with
    | vNil => v2
    | vCons _ e v1' => vCons e (vapp v1' v2)
  end.

Example vapp_ex1:
  vapp (vCons 1 (vCons 2 (vCons 3 vNil)))
       (vCons 4 (vCons 5 vNil))
  = vCons 1 (vCons 2 (vCons 3 (vCons 4 (vCons 5 vNil)))).
Proof.
  compute.
  reflexivity.
Qed.

Definition vlength {A:Set} {n:nat} (v:vector A n) : nat := n.

(** ** Exercice *)

Lemma vappa_vlength:
  forall A : Set,
  forall n1 n2 : nat,
  forall v1 : vector A n1,
  forall v2 : vector A n2,
    vlength (vapp v1 v2) = n1 + n2.
Proof.
  intros A n1 n2 v1 v2.
  induction v1 as [|v v'].
  -compute.
   reflexivity.
  -simpl.
   rewrite <- IHv1.

(** ** Exercice *)

(* <<DEFINIR vmap ICI>> *)

Example vmap_ex1:
  vmap (fun b:bool => match b with
                        | true => 1
                        | false => 0
                      end) (vCons true (vCons false vNil))
  = vCons 1 (vCons 0 vNil).
Proof.
  compute. reflexivity.
Qed.

(** ** Exercice *)

(* <<DEFINIR list_from_vect ICI>>> *)

Example list_from_vect_ex1:
  list_from_vect (vCons true (vCons false vNil)) = true :: false :: nil.
Proof.
  compute. reflexivity.
Qed.

(** ** Exercice *)

Lemma vmap_map:
  forall A B:Set,
  forall f : A->B,
  forall n:nat,
  forall v : vector A n,
    list_from_vect (vmap f v) = map f (list_from_vect v).
Proof.
  (* <<COMPLETER ICI>> *)

(** ** Exercice *)

(* <<DEFINIR vect_from_list ICI>> *)

 Example vect_from_list_ex1:
  vect_from_list (true::false::nil) = vCons true (vCons false vNil).
Proof.
  compute. reflexivity.
Qed.

(** ** Exercice *)

Theorem vect_list_convert:
  forall A : Set,
  forall l : list A,
    list_from_vect (vect_from_list l) = l.
Proof.
  (* <<COMPLETER ICI>> *)


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

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

Definition and (b₁ : bool) (b₂ : bool) : bool :=
  match b₁ with
   | true => b₂
   | false => false
  end.

Definition or (b₁ : bool) (b₂ : bool) : bool :=
  match b₁ with
   | true => true
   | false => b₂
  end.

(* Unit tests *)
Example test_or_1: (or true false) = true.
Proof. simpl. reflexivity. Qed.
Example test_or_2: (or false false) = false.
Proof. simpl. reflexivity. Qed.
Example test_or_3: (or false true) = true.
Proof. simpl. reflexivity. Qed.
Example test_or_4: (or true true) = true.
Proof. simpl. reflexivity. Qed.

(* Introduce notations *)
Notation "x && y" := (and x y).
Notation "x || y" := (or x y).

Example test_or_5: false || false || true = true.
Proof. simpl. reflexivity. Qed.

(* Exercise: implement nand *)
Definition nand (b₁ : bool) (b₂ : bool) : bool :=
  match b₁ with
    | true => not b₂
    | false => true
  end.

Example test_nand_1: (nand true false) = true.
Proof. simpl. reflexivity. Qed.
Example test_nand_2: (nand false false) = true.
Proof. simpl. reflexivity. Qed.
Example test_nand_3: (nand false true) = true.
Proof. simpl. reflexivity. Qed.
Example test_nand_4: (nand true true) = false.
Proof. simpl. reflexivity. Qed.

(* Exercise: implement and3 *)
Definition and3 (b₁ : bool) (b₂ : bool) (b₃ : bool) : bool :=
  match b₁ with
    | true =>
      match b₂ with
        | true => b₃
        | false => false
      end
    | false => false
  end.

Example test_and3_1: (and3 true true true) = true.
Proof. simpl. reflexivity. Qed.
Example test_and3_2: (and3 false true true) = false.
Proof. simpl. reflexivity. Qed.
Example test_and3_3: (and3 true false true) = false.
Proof. simpl. reflexivity. Qed.
Example test_and3_4: (and3 true true false) = false.
Proof. simpl. reflexivity. Qed.

(* We can check the type of an expression *)
Check not.


(************************************************************************)
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010     *)
(*   \VV/  **************************************************************)
(*    //   *      This file is distributed under the terms of the       *)
(*         *       GNU Lesser General Public License Version 2.1        *)
(************************************************************************)

(** Theorems about [gt] in [nat]. [gt] is defined in [Init/Peano.v] as:
<<
Definition gt (n m:nat) := m < n.
>>
*)

Require Import Le.
Require Import Lt.
Require Import Plus.
Open Local Scope nat_scope.

Implicit Types m n p : nat.

(** * Order and successor *)

Theorem gt_Sn_O : forall n, S n > 0.
Proof.
  auto with arith.
Qed.
Hint Resolve gt_Sn_O: arith v62.

Theorem gt_Sn_n : forall n, S n > n.
Proof.
  auto with arith.
Qed.
Hint Resolve gt_Sn_n: arith v62.

Theorem gt_n_S : forall n m, n > m -> S n > S m.
Proof.
  auto with arith.
Qed.
Hint Resolve gt_n_S: arith v62.

Lemma gt_S_n : forall n m, S m > S n -> m > n.
Proof.
  auto with arith.
Qed.
Hint Immediate gt_S_n: arith v62.

Theorem gt_S : forall n m, S n > m -> n > m \/ m = n.
Proof.
  intros n m H; unfold gt in |- *; apply le_lt_or_eq; auto with arith.
Qed.

Lemma gt_pred : forall n m, m > S n -> pred m > n.
Proof.
  auto with arith.
Qed.
Hint Immediate gt_pred: arith v62.

(** * Irreflexivity *)

Lemma gt_irrefl : forall n, ~ n > n.
Proof lt_irrefl.
Hint Resolve gt_irrefl: arith v62.

(** * Asymmetry *)

Lemma gt_asym : forall n m, n > m -> ~ m > n.
Proof fun n m => lt_asym m n.

Hint Resolve gt_asym: arith v62.

(** * Relating strict and large orders *)

Lemma le_not_gt : forall n m, n <= m -> ~ n > m.
Proof le_not_lt.
Hint Resolve le_not_gt: arith v62.

Lemma gt_not_le : forall n m, n > m -> ~ n <= m.
Proof.
auto with arith.
Qed.

Hint Resolve gt_not_le: arith v62.

Theorem le_S_gt : forall n m, S n <= m -> m > n.
Proof.
  auto with arith.
Qed.
Hint Immediate le_S_gt: arith v62.

Lemma gt_S_le : forall n m, S m > n -> n <= m.
Proof.
  intros n p; exact (lt_n_Sm_le n p).
Qed.
Hint Immediate gt_S_le: arith v62.

Lemma gt_le_S : forall n m, m > n -> S n <= m.
Proof.
  auto with arith.
Qed.
Hint Resolve gt_le_S: arith v62.

Lemma le_gt_S : forall n m, n <= m -> S m > n.
Proof.
  auto with arith.
Qed.
Hint Resolve le_gt_S: arith v62.

(** * Transitivity *)

Theorem le_gt_trans : forall n m p, m <= n -> m > p -> n > p.
Proof.
  red in |- *; intros; apply lt_le_trans with m; auto with arith.
Qed.

Theorem gt_le_trans : forall n m p, n > m -> p <= m -> n > p.
Proof.
  red in |- *; intros; apply le_lt_trans with m; auto with arith.
Qed.

Lemma gt_trans : forall n m p, n > m -> m > p -> n > p.
Proof.
  red in |- *; intros n m p H1 H2.
  apply lt_trans with m; auto with arith.
Qed.

Theorem gt_trans_S : forall n m p, S n > m -> m > p -> n > p.
Proof.
  red in |- *; intros; apply lt_le_trans with m; auto with arith.
Qed.

Hint Resolve gt_trans_S le_gt_trans gt_le_trans: arith v62.

(** * Comparison to 0 *)

Theorem gt_0_eq : forall n, n > 0 \/ 0 = n.
Proof.
  intro n; apply gt_S; auto with arith.
Qed.

(** * Simplification and compatibility *)

Lemma plus_gt_reg_l : forall n m p, p + n > p + m -> n > m.
Proof.
  red in |- *; intros n m p H; apply plus_lt_reg_l with p; auto with arith.
Qed.

Lemma plus_gt_compat_l : forall n m p, n > m -> p + n > p + m.
Proof.
  auto with arith.
Qed.
Hint Resolve plus_gt_compat_l: arith v62.

(* begin hide *)
Notation gt_O_eq := gt_0_eq (only parsing).
(* end hide *)


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

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