Module Type LocalNat.

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

End LocalNat.

Print nat.

Print le.

Theorem zero_leq_three: 0 <= 3.

Proof.
 constructor 2.
 constructor 2.
 constructor 2.
 constructor 1.

Qed.

Print zero_leq_three.

Lemma zero_leq_three': 0 <= 3.
 repeat constructor.
Qed.

Lemma zero_lt_three : 0 < 3.
Proof.
 unfold lt.
 repeat constructor.
Qed.

Require Import List.

Print list.

Check list.

Check (nil (A:=nat)).

Check (nil (A:= nat -> nat)).

Check (fun A: Set => (cons (A:=A))).

Check (cons 3 (cons 2 nil)).

Require Import Bvector.

Print Vector.t.

Check (Vector.nil nat).

Check (fun (A:Set)(a:A)=> Vector.cons _ a _ (Vector.nil _)).

Check (Vector.cons _ 5 _ (Vector.cons _ 3 _ (Vector.nil _))).

Lemma eq_3_3 : 2 + 1 = 3.
Proof.
 reflexivity.
Qed.
Print eq_3_3.

Lemma eq_proof_proof : refl_equal (2*6) = refl_equal (3*4).
Proof.
 reflexivity.
Qed.
Print eq_proof_proof.

Lemma eq_lt_le : ( 2 < 4) = (3 <= 4).
Proof.
 reflexivity.
Qed.

Lemma eq_nat_nat : nat = nat.
Proof.
 reflexivity.
Qed.

Lemma eq_Set_Set : Set = Set.
Proof.
 reflexivity.
Qed.

Lemma eq_Type_Type : Type = Type.
Proof.
 reflexivity.
Qed.

Check (2 + 1 = 3).

Check (Type = Type).

Goal Type = Type.
reflexivity.
Qed.

Print or.

Print and.

Print sumbool.

Print ex.

Require Import ZArith.
Require Import Compare_dec.

Check le_lt_dec.

Definition max (n p :nat) := match le_lt_dec n p with
                             | left _ => p
                             | right _ => n
                             end.

Theorem le_max : forall n p, n <= p -> max n p = p.
Proof.
 intros n p ; unfold max ; case (le_lt_dec n p); simpl.
 trivial.
 intros; absurd (p < p); eauto with arith.
Qed.

Require Coq.extraction.Extraction.
Extraction max.

Inductive tree(A:Set)   : Set :=
    node : A -> forest A -> tree A
with
  forest (A: Set)    : Set :=
    nochild  : forest A |
    addchild : tree A -> forest A -> forest A.

Inductive
  even    : nat->Prop :=
    evenO : even  O |
    evenS : forall n, odd n -> even (S n)
with
  odd    : nat->Prop :=
    oddS : forall n, even n -> odd (S n).

Lemma odd_49 : odd (7 * 7).
 simpl; repeat constructor.
Qed.

Definition nat_case :=
 fun (Q : Type)(g0 : Q)(g1 : nat -> Q)(n:nat) =>
    match n return Q with
    | 0 => g0
    | S p => g1 p
    end.

Eval simpl in (nat_case nat 0 (fun p => p) 34).

Eval simpl in (fun g0 g1 => nat_case nat g0 g1 34).

Eval simpl in (fun g0 g1 => nat_case nat g0 g1 0).

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

Eval simpl in pred 56.

Eval simpl in pred 0.

Eval simpl in fun p => pred (S p).

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

 Definition pred_spec (n:nat) := {m:nat | n=0 /\ m=0  \/ n = S m}.

 Definition predecessor : forall n:nat, pred_spec n.
  intro n;case n.
  unfold pred_spec;exists 0;auto.
  unfold pred_spec; intro n0;exists n0; auto.
 Defined.

Print predecessor.

Extraction predecessor.

Theorem nat_expand :
  forall n:nat, n = match n with 0 => 0 | S p => S p end.
 intro n;case n;simpl;auto.
Qed.

Check (fun p:False => match p return 2=3 with end).

Theorem fromFalse : False -> 0=1.
 intro absurd.
 contradiction.
Qed.

Section equality_elimination.
 Variables (A: Type)
           (a b : A)
           (p : a = b)
           (Q : A -> Type).
 Check (fun H : Q a =>
  match p in (eq _  y) return Q y with
     refl_equal => H
  end).

End equality_elimination.

Theorem trans : forall n m p:nat, n=m -> m=p -> n=p.
Proof.
 intros n m p eqnm.
 case eqnm.
 trivial.
Qed.

Lemma Rw :  forall x y: nat, y = y * x -> y * x * x = y.
 intros x y e; do 2 rewrite <- e.
 reflexivity.
Qed.

Require Import Arith.

Check mult_1_l.
(*
mult_1_l
     : forall n : nat, 1 * n = n
*)

Check mult_plus_distr_r.
(*
mult_plus_distr_r
     : forall n m p : nat, (n + m) * p = n * p + m * p

*)

Lemma mult_distr_S : forall n p : nat, n * p + p = (S n)* p.
 simpl;auto with arith.
Qed.

Lemma four_n : forall n:nat, n+n+n+n = 4*n.
 intro n;rewrite <- (mult_1_l n).

 Undo.
 intro n; pattern n at 1.

 rewrite <- mult_1_l.
 repeat rewrite   mult_distr_S.
 trivial.
Qed.

Section Le_case_analysis.
 Variables (n p : nat)
           (H : n <= p)
           (Q : nat -> Prop)
           (H0 : Q n)
           (HS : forall m, n <= m -> Q (S m)).
 Check (
    match H in (_ <= q) return (Q q)  with
    | le_n _ => H0
    | le_S _ m Hm => HS m Hm
    end
  ).

End Le_case_analysis.

Lemma predecessor_of_positive : forall n, 1 <= n ->  exists p:nat, n = S p.
Proof.
 intros n  H; case H.
 exists 0; trivial.
 intros m Hm; exists m;trivial.
Qed.

Definition Vtail_total
   (A : Set) (n : nat) (v : Vector.t A n) : Vector.t A (pred n):=
match v in (Vector.t _ n0) return (Vector.t A (pred n0)) with
| Vector.nil _ => Vector.nil A
| Vector.cons _ _ n0 v0 => v0
end.

Definition Vtail' (A:Set)(n:nat)(v:Vector.t A n) : Vector.t A (pred n).
 case v.
 simpl.
 exact (Vector.nil A).
 simpl.
 auto.
Defined.

(*
Inductive Lambda : Set :=
  lambda : (Lambda -> False) -> Lambda.

Error: Non strictly positive occurrence of "Lambda" in
 "(Lambda -> False) -> Lambda"

*)

Section Paradox.
 Variable Lambda : Set.
 Variable lambda : (Lambda -> False) ->Lambda.

 Variable matchL  : Lambda -> forall Q:Prop, ((Lambda ->False) -> Q) -> Q.
 (*
  understand matchL Q l (fun h : Lambda -> False => t)

  as match l return Q with lambda h => t end
 *)

 Definition application (f x: Lambda) :False :=
   matchL f False (fun h => h x).

 Definition Delta : Lambda := lambda (fun x : Lambda => application x x).

 Definition loop : False := application Delta Delta.

 Theorem two_is_three : 2 = 3.
 Proof.
  elim loop.
 Qed.

End Paradox.

Require Import ZArith.

Inductive itree : Set :=
| ileaf : itree
| inode : Z-> (nat -> itree) -> itree.

Definition isingle l := inode l (fun i => ileaf).

Definition t1 := inode 0 (fun n => isingle (Z.of_nat (2*n))).

Definition t2 := inode 0
                      (fun n : nat =>
                               inode (Z.of_nat n)
                                     (fun p => isingle (Z.of_nat (n*p)))).

Inductive itree_le : itree-> itree -> Prop :=
  | le_leaf : forall t, itree_le  ileaf t
  | le_node  : forall l l' s s',
                       Z.le l l' ->
                      (forall i, exists j:nat, itree_le (s i) (s' j)) ->
                      itree_le  (inode  l s) (inode  l' s').

Theorem itree_le_trans :
  forall t t', itree_le t t' ->
               forall t'', itree_le t' t'' -> itree_le t t''.
 induction t.
 constructor 1.

 intros t'; case t'.
 inversion 1.
 intros z0 i0 H0.
 intro t'';case t''.
 inversion 1.
 intros.
 inversion_clear H1.
 constructor 2.
 inversion_clear H0;eauto with zarith.
 inversion_clear H0.
 intro i2; case (H4 i2).
 intros.
 generalize (H i2 _ H0).
 intros.
 case (H3 x);intros.
 generalize (H5 _ H6).
 exists x0;auto.
Qed.

Inductive itree_le' : itree-> itree -> Prop :=
  | le_leaf' : forall t, itree_le'  ileaf t
  | le_node' : forall l l' s s' g,
                       Z.le l l' ->
                      (forall i, itree_le' (s i) (s' (g i))) ->
                       itree_le'  (inode  l s) (inode  l' s').

Lemma t1_le_t2 : itree_le t1 t2.
 unfold t1, t2.
 constructor.
 auto with zarith.
 intro i; exists (2 * i).
 unfold isingle.
 constructor.
 auto with zarith.
 exists i;constructor.
Qed.

Lemma t1_le'_t2 :  itree_le' t1 t2.
 unfold t1, t2.
 constructor 2  with (fun i : nat => 2 * i).
 auto with zarith.
 unfold isingle;
 intro i ; constructor 2 with (fun i :nat => i).
 auto with zarith.
 constructor .
Qed.

Require Import List.

Inductive ltree  (A:Set) : Set :=
          lnode   : A -> list (ltree A) -> ltree A.

Inductive prop : Prop :=
 prop_intro : Prop -> prop.

Lemma prop_inject: prop.
Proof prop_intro prop.

Inductive ex_Prop  (P : Prop -> Prop) : Prop :=
  exP_intro : forall X : Prop, P X -> ex_Prop P.

Lemma ex_Prop_inhabitant : ex_Prop (fun P => P -> P).
Proof.
  exists (ex_Prop (fun P => P -> P)).
 trivial.
Qed.

Fail Check (fun (P:Prop->Prop)(p: ex_Prop P) =>
      match p with exP_intro X HX => X end).
(*
Error:
Incorrect elimination of "p" in the inductive type
"ex_Prop", the return type has sort "Type" while it should be
"Prop"

Elimination of an inductive object of sort "Prop"
is not allowed on a predicate in sort "Type"
because proofs can be eliminated only to build proofs
*)

Fail Check (match prop_inject with (prop_intro p) => p end).
(*
Error:
Incorrect elimination of "prop_inject" in the inductive type
"prop", the return type has sort "Type" while it should be
"Prop"

Elimination of an inductive object of sort "Prop"
is not allowed on a predicate in sort "Type"
because proofs can be eliminated only to build proofs
*)
Print prop_inject.

(*
prop_inject =
prop_inject = prop_intro prop
     : prop
*)

Inductive  typ : Type :=
  typ_intro : Type -> typ.

Definition typ_inject: typ.
split.
Fail exact typ.
(*
Error: Universe Inconsistency.
*)
Abort.

Fail Inductive aSet : Set :=
  aSet_intro: Set -> aSet.
(*
User error: Large non-propositional inductive types must be in Type
*)

Inductive ex_Set  (P : Set -> Prop) : Type :=
  exS_intro : forall X : Set, P X -> ex_Set P.

Module Type Version1.

Inductive comes_from_the_left (P Q:Prop): P \/ Q -> Prop :=
  c1 : forall p, comes_from_the_left P Q (or_introl (A:=P) Q p).

Goal (comes_from_the_left _ _ (or_introl True I)).
split.
Qed.

Goal ~(comes_from_the_left _ _ (or_intror True I)).
 red;inversion 1.
 (* discriminate H0.
 *)
Abort.

End Version1.

Fail Definition comes_from_the_left (P Q:Prop)(H:P \/ Q): Prop :=
  match H with
         |  or_introl p => True
         |  or_intror q => False
  end.

(*
Error:
Incorrect elimination of "H" in the inductive type
"or", the return type has sort "Type" while it should be
"Prop"

Elimination of an inductive object of sort "Prop"
is not allowed on a predicate in sort "Type"
because proofs can be eliminated only to build proofs
*)

Definition comes_from_the_left_sumbool
            (P Q:Prop)(x:{P}+{Q}): Prop :=
  match x with
         |  left  p => True
         |  right q => False
  end.

Close Scope Z_scope.

Theorem S_is_not_O : forall n, S n <> 0.

Set Nested Proofs Allowed.

Definition Is_zero (x:nat):= match x with
                                     | 0 => True
                                     | _ => False
                             end.
 Lemma O_is_zero : forall m, m = 0 -> Is_zero m.
 Proof.
  intros m H; subst m.
  (*
  ============================
   Is_zero 0
  *)
  simpl;trivial.
 Qed.

 red; intros n Hn.
 apply O_is_zero with (m := S n).
 assumption.
Qed.

Theorem disc2 : forall n, S (S n) <> 1.
Proof.
 intros n Hn; discriminate.
Qed.

Theorem disc3 : forall n, S (S n) = 0 -> forall Q:Prop, Q.
Proof.
  intros n Hn Q.
  discriminate.
Qed.

Theorem inj_succ  : forall n m, S n = S m -> n = m.
Proof.

Lemma inj_pred : forall n m, n = m -> pred n = pred m.
Proof.
 intros n m eq_n_m.
 rewrite eq_n_m.
 trivial.
Qed.

 intros n m eq_Sn_Sm.
 apply inj_pred with (n:= S n) (m := S m); assumption.
Qed.

Lemma list_inject : forall (A:Set)(a b :A)(l l':list A),
                     a :: b :: l = b :: a :: l' -> a = b /\ l = l'.
Proof.
 intros A a b l l' e.
 injection e.
 auto.
Qed.

Theorem not_le_Sn_0 : forall n:nat, ~ (S n <= 0).
Proof.
 red; intros n H.
 case H.
Undo.

Lemma not_le_Sn_0_with_constraints :
  forall n p , S n <= p ->  p = 0 -> False.
Proof.
 intros n p H; case H ;
   intros; discriminate.
Qed.

eapply not_le_Sn_0_with_constraints; eauto.
Qed.

Theorem not_le_Sn_0' : forall n:nat, ~ (S n <= 0).
Proof.
 red; intros n H ; inversion H.
Qed.

Derive Inversion le_Sn_0_inv with (forall n :nat, S n <=  0).
Check le_Sn_0_inv.

Theorem le_Sn_0'' : forall n p : nat, ~ S n <= 0 .
Proof.
 intros n p H;
 inversion H using le_Sn_0_inv.
Qed.

Derive Inversion_clear le_Sn_0_inv' with (forall n :nat, S n <=  0).
Check le_Sn_0_inv'.

Theorem le_reverse_rules :
 forall n m:nat, n <= m ->
                   n = m \/
                   exists p, n <=  p /\ m = S p.
Proof.
  intros n m H; inversion H.
  left;trivial.
  right; exists m0; split; trivial.
Restart.
  intros n m H; inversion_clear H.
  left;trivial.
  right; exists m0; split; trivial.
Qed.

Inductive ArithExp : Set :=
     Zero : ArithExp
   | Succ : ArithExp -> ArithExp
   | Plus : ArithExp -> ArithExp -> ArithExp.

Inductive RewriteRel : ArithExp -> ArithExp -> Prop :=
     RewSucc  : forall e1 e2 :ArithExp,
                  RewriteRel e1 e2 -> RewriteRel (Succ e1) (Succ e2)
  |  RewPlus0 : forall e:ArithExp,
                  RewriteRel (Plus Zero e) e
  |  RewPlusS : forall e1 e2:ArithExp,
                  RewriteRel e1 e2 ->
                  RewriteRel (Plus (Succ e1) e2) (Succ (Plus e1 e2)).

Fixpoint plus (n p:nat) {struct n} : nat :=
  match n with
          | 0 => p
          | S m => S (plus m p)
 end.

Fixpoint plus' (n p:nat) {struct p} : nat :=
    match p with
          | 0 => n
          | S q => S (plus' n q)
    end.

Fixpoint plus'' (n p:nat) {struct n} : nat :=
  match n with
          | 0 => p
          | S m => plus'' m (S p)
 end.

Module Type even_test_v1.

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

End even_test_v1.

Module even_test_v2.

Fixpoint even_test (n:nat) : bool :=
  match n
  with
      | 0 =>  true
      | S p => odd_test p
  end
with odd_test (n:nat) : bool :=
  match n
  with
     | 0 => false
     | S p => even_test p
 end.

Eval simpl in even_test.

Eval simpl in (fun x : nat => even_test x).

Eval simpl in (fun x : nat => plus 5 x).
Eval simpl in (fun x : nat => even_test (plus 5 x)).

Eval simpl in (fun x : nat => even_test (plus x 5)).

End even_test_v2.

Section Principle_of_Induction.
Variable    P               : nat -> Prop.
Hypothesis  base_case       : P 0.
Hypothesis  inductive_step   : forall n:nat, P n -> P (S n).
Fixpoint nat_ind  (n:nat)    : (P n) :=
   match n return P n with
          | 0 => base_case
          | S m => inductive_step m (nat_ind m)
   end.

End Principle_of_Induction.

Scheme Even_induction := Minimality for even Sort Prop
with   Odd_induction  := Minimality for odd  Sort Prop.

Theorem even_plus_four : forall n:nat, even n -> even (4+n).
Proof.
 intros n H.
 elim H using Even_induction with (P0 := fun n => odd (4+n));
 simpl;repeat constructor;assumption.
Qed.

Section Principle_of_Double_Induction.
Variable    P               : nat -> nat ->Prop.
Hypothesis  base_case1      : forall x:nat, P 0 x.
Hypothesis  base_case2      : forall x:nat, P (S x) 0.
Hypothesis  inductive_step   : forall n m:nat, P n m -> P (S n) (S m).
Fixpoint nat_double_ind (n m:nat){struct n} : P n m :=
  match n, m return P n m with
         |  0 ,     x    =>  base_case1 x
         |  (S x),    0  =>  base_case2 x
         |  (S x), (S y) =>  inductive_step x y (nat_double_ind x y)
     end.
End Principle_of_Double_Induction.

Section Principle_of_Double_Recursion.
Variable    P               : nat -> nat -> Set.
Hypothesis  base_case1      : forall x:nat, P 0 x.
Hypothesis  base_case2      : forall x:nat, P (S x) 0.
Hypothesis  inductive_step   : forall n m:nat, P n m -> P (S n) (S m).
Fixpoint nat_double_rec (n m:nat){struct n} : P n m :=
  match n, m return P n m with
         |   0 ,     x    =>  base_case1 x
         |  (S x),    0   => base_case2 x
         |  (S x), (S y)  => inductive_step x y (nat_double_rec x y)
     end.
End Principle_of_Double_Recursion.

Definition min : nat -> nat -> nat  :=
  nat_double_rec (fun (x y:nat) => nat)
                 (fun (x:nat) => 0)
                 (fun (y:nat) => 0)
                 (fun (x y r:nat) => S r).

Eval compute in (min 5 8).
Eval compute in (min 8 5).

Lemma not_circular : forall n:nat, n <> S n.
Proof.
 intro n.
 apply nat_ind with (P:= fun n => n <> S n).
 discriminate.
 red; intros n0 Hn0 eqn0Sn0;injection eqn0Sn0;auto.
Qed.

Definition eq_nat_dec : forall n p:nat , {n=p}+{n <> p}.
Proof.
 intros n p.
 apply nat_double_rec with (P:= fun (n q:nat) => {q=p}+{q <> p}).
Undo.
 pattern p,n.
 elim n using nat_double_rec.
 destruct x; auto.
 destruct x; auto.
 intros n0 m H; case H.
 intro eq; rewrite eq ; auto.
 intro neg; right; red ; injection 1; auto.
Defined.

Definition eq_nat_dec' : forall n p:nat, {n=p}+{n <> p}.
 decide equality.
Defined.

Print Acc.

Require Import Minus.

Fail Fixpoint div (x y:nat){struct x}: nat :=
 if eq_nat_dec x 0
  then 0
  else if eq_nat_dec y 0
       then x
       else S (div (x-y) y).
(*
Error:
Recursive definition of div is ill-formed.
In environment
div : nat -> nat -> nat
x : nat
y : nat
_ : x <> 0
_ : y <> 0

Recursive call to div has principal argument equal to
"x - y"
instead of a subterm of x

*)

Lemma minus_smaller_S: forall x y:nat, x - y < S x.
Proof.
 intros x y; pattern y, x;
 elim x using nat_double_ind.
 destruct x0; auto with arith.
 simpl; auto with arith.
 simpl; auto with arith.
Qed.

Lemma minus_smaller_positive : forall x y:nat, x <>0 -> y <> 0 ->
                                     x - y < x.
Proof.
 destruct x; destruct y;
 ( simpl;intros; apply minus_smaller_S ||
   intros; absurd (0=0); auto).
Qed.

Definition minus_decrease : forall x y:nat, Acc lt x ->
                                         x <> 0 ->
                                         y <> 0 ->
                                         Acc lt (x-y).
Proof.
 intros x y H; case H.
 intros Hz posz posy.
 apply Hz; apply minus_smaller_positive; assumption.
Defined.

Print minus_decrease.

Fixpoint div_aux (x y:nat)(H: Acc lt x):nat.
  refine (if eq_nat_dec x 0
         then 0
         else if eq_nat_dec y 0
              then y
              else div_aux (x-y) y _).
 apply (minus_decrease x y H);assumption.
Defined.

Print div_aux.
(*
div_aux =
(fix div_aux (x y : nat) (H : Acc lt x) {struct H} : nat :=
   match eq_nat_dec x 0 with
   | left _ => 0
   | right _ =>
       match eq_nat_dec y 0 with
       | left _ => y
       | right _0 => div_aux (x - y) y (minus_decrease x y H _ _0)
       end
   end)
     : forall x : nat, nat -> Acc lt x -> nat
*)

Require Import Wf_nat.
Definition div x y := div_aux x y (lt_wf x).

Extraction div.
(*
let div x y =
  div_aux x y
*)

Extraction div_aux.

(*
let rec div_aux x y =
  match eq_nat_dec x O with
    | Left -> O
    | Right ->
        (match eq_nat_dec y O with
           | Left -> y
           | Right -> div_aux (minus x y) y)
*)

Lemma vector0_is_vnil : forall (A:Set)(v:Vector.t A 0), v = Vector.nil A.
Proof.
 intros A v;inversion v.
Abort.

Fail Lemma vector0_is_vnil_aux : forall (A:Set)(n:nat)(v:Vector.t A n),
                                  n= 0 -> v = Vector.nil A.
(*
Error: In environment
A : Set
n : nat
v : Vector.t A n
The term "[]" has type "Vector.t A 0" while it is expected to have type
 "Vector.t A n"
*)
 Require Import JMeq.

Lemma vector0_is_vnil_aux : forall (A:Set)(n:nat)(v:Vector.t A n),
                                  n= 0 -> JMeq v (Vector.nil A).
Proof.
 destruct v.
 auto.
 intro; discriminate.
Qed.

Lemma vector0_is_vnil : forall (A:Set)(v:Vector.t A 0), v = Vector.nil A.
Proof.
 intros a v;apply JMeq_eq.
 apply vector0_is_vnil_aux.
 trivial.
Qed.

Arguments Vector.cons [A] _ [n].
Arguments Vector.nil [A].
Arguments Vector.hd [A n].
Arguments Vector.tl [A n].

Definition Vid : forall (A : Type)(n:nat), Vector.t A n -> Vector.t A n.
Proof.
 destruct n; intro v.
 exact Vector.nil.
 exact (Vector.cons  (Vector.hd v) (Vector.tl v)).
Defined.

Eval simpl in (fun (A:Set)(v:Vector.t A 0) => (Vid _ _ v)).

Eval simpl in (fun (A:Set)(v:Vector.t A 0) => v).

Lemma Vid_eq : forall (n:nat) (A:Type)(v:Vector.t A n), v=(Vid _ n v).
Proof.
 destruct v.
 reflexivity.
 reflexivity.
Defined.

Theorem zero_nil : forall A (v:Vector.t A 0), v = Vector.nil.
Proof.
 intros.
 change (Vector.nil (A:=A)) with (Vid _ 0 v).
 apply Vid_eq.
Defined.

Theorem decomp :
  forall (A : Set) (n : nat) (v : Vector.t A (S n)),
  v = Vector.cons (Vector.hd v) (Vector.tl v).
Proof.
 intros.
 change (Vector.cons (Vector.hd v) (Vector.tl v)) with (Vid _  (S n) v).
 apply Vid_eq.
Defined.

Definition vector_double_rect :
    forall (A:Set) (P: forall (n:nat),(Vector.t A n)->(Vector.t A n) -> Type),
        P 0 Vector.nil Vector.nil ->
        (forall n (v1 v2 : Vector.t A n) a b, P n v1 v2 ->
             P (S n) (Vector.cons a v1) (Vector.cons  b v2)) ->
        forall n (v1 v2 : Vector.t A n), P n v1 v2.
 induction n.
 intros; rewrite (zero_nil _ v1); rewrite (zero_nil _ v2).
 auto.
 intros v1 v2; rewrite (decomp _ _ v1);rewrite (decomp _ _ v2).
 apply X0; auto.
Defined.

Require Import Bool.

Definition bitwise_or n v1 v2 : Vector.t bool n :=
   vector_double_rect bool  (fun n v1 v2 => Vector.t bool n)
                        Vector.nil
                        (fun n v1 v2 a b r => Vector.cons (orb a b) r) n v1 v2.

Fixpoint vector_nth (A:Set)(n:nat)(p:nat)(v:Vector.t A p){struct v}
                  : option A :=
  match n,v  with
    _   , Vector.nil => None
  | 0   , Vector.cons b _ => Some b
  | S n', Vector.cons _ v' => vector_nth A n' _ v'
  end.

Arguments vector_nth [A] _ [p].

Lemma nth_bitwise : forall (n:nat) (v1 v2: Vector.t bool n) i  a b,
      vector_nth i v1 = Some a ->
      vector_nth i v2 = Some b ->
      vector_nth i (bitwise_or _ v1 v2) = Some (orb a b).
Proof.
 intros  n v1 v2; pattern n,v1,v2.
 apply vector_double_rect.
 simpl.
 destruct i; discriminate 1.
 destruct i; simpl;auto.
 injection 1 as ->; injection 1 as ->; auto.
Qed.

 Set Implicit Arguments.

 CoInductive Stream (A:Set) : Set   :=
 |  Cons : A -> Stream A -> Stream A.

 CoInductive LList (A: Set) : Set :=
 |  LNil : LList A
 |  LCons : A -> LList A -> LList A.

 Definition head (A:Set)(s : Stream A) := match s with Cons a s' => a end.

 Definition tail (A : Set)(s : Stream A) :=
      match s with Cons a s' => s' end.

 CoFixpoint repeat (A:Set)(a:A) : Stream A := Cons a (repeat a).

 CoFixpoint iterate (A: Set)(f: A -> A)(a : A) : Stream A:=
    Cons a (iterate f (f a)).

 CoFixpoint map (A B:Set)(f: A -> B)(s : Stream A) : Stream B:=
  match s with Cons a tl => Cons (f a) (map f tl) end.

Eval simpl in (fun (A:Set)(a:A) => repeat a).

Eval simpl in (fun (A:Set)(a:A) => head (repeat a)).

CoInductive EqSt (A: Set) : Stream A -> Stream A -> Prop :=
  eqst : forall s1 s2: Stream A,
      head s1 = head s2 ->
      EqSt (tail s1) (tail s2) ->
      EqSt s1 s2.

Section Parks_Principle.
Variable A : Set.
Variable    R      : Stream A -> Stream A -> Prop.
Hypothesis  bisim1 : forall s1 s2:Stream A, R s1 s2 ->
                                          head s1 = head s2.
Hypothesis  bisim2 : forall s1 s2:Stream A, R s1 s2 ->
                                          R (tail s1) (tail s2).

CoFixpoint park_ppl     : forall s1 s2:Stream A, R s1 s2 ->
                                               EqSt s1 s2 :=
 fun s1 s2 (p : R s1 s2) =>
      eqst s1 s2 (bisim1  p)
                 (park_ppl  (bisim2  p)).
End Parks_Principle.

Theorem map_iterate : forall (A:Set)(f:A->A)(x:A),
                       EqSt (iterate f (f x)) (map f (iterate f x)).
Proof.
 intros A f x.
 apply park_ppl with
   (R:=  fun s1 s2 => exists x: A,
                      s1 = iterate f (f x) /\ s2 = map f (iterate f x)).

 intros s1 s2 (x0,(eqs1,eqs2));rewrite eqs1;rewrite eqs2;reflexivity.
 intros s1 s2 (x0,(eqs1,eqs2)).
 exists (f x0);split;[rewrite eqs1|rewrite eqs2]; reflexivity.
 exists x;split; reflexivity.
Qed.

Ltac infiniteproof f :=
  cofix f; constructor; [clear f| simpl; try (apply f; clear f)].

Theorem map_iterate' : forall (A:Set)(f:A->A)(x:A),
                       EqSt (iterate f (f x)) (map f (iterate f x)).
infiniteproof map_iterate'.
 reflexivity.
Qed.

Arguments LNil [A].

Lemma Lnil_not_Lcons : forall (A:Set)(a:A)(l:LList A),
                               LNil <> (LCons a l).
 intros;discriminate.
Qed.

Lemma injection_demo : forall (A:Set)(a b : A)(l l': LList A),
                       LCons a (LCons b l) = LCons b (LCons a l') ->
                       a = b /\ l = l'.
Proof.
 intros A a b l l' e; injection e; auto.
Qed.

Inductive Finite (A:Set) : LList A -> Prop :=
|  Lnil_fin : Finite (LNil (A:=A))
|  Lcons_fin : forall a l, Finite l -> Finite (LCons a l).

CoInductive Infinite  (A:Set) : LList A -> Prop :=
| LCons_inf : forall a l, Infinite l -> Infinite (LCons a l).

Lemma LNil_not_Infinite : forall (A:Set), ~ Infinite (LNil (A:=A)).
Proof.
  intros A H;inversion H.
Qed.

Lemma Finite_not_Infinite : forall (A:Set)(l:LList A),
                                Finite l -> ~ Infinite l.
Proof.
 intros A l H; elim H.
 apply LNil_not_Infinite.
 intros a l0 F0 I0' I1.
 case I0'; inversion_clear I1.
 trivial.
Qed.

Lemma Not_Finite_Infinite : forall (A:Set)(l:LList A),
                            ~ Finite l -> Infinite l.
Proof.
 cofix H.
 destruct l.
 intro; absurd (Finite (LNil (A:=A)));[auto|constructor].
 constructor.
 apply H.
 red; intro H1;case H0.
 constructor.
 trivial.
Qed.


From Coq Require Import List Lia ZArith.

Global Open Scope list_scope.

(* Check that a predicate holds elementwise across two lists, while
   also making sure that the lists have equal length.
*)
Fixpoint zip_pred {X Y} (pred : X -> Y -> bool) (xs : list X) (ys : list Y) : bool
  := match xs, ys with
     | nil, nil => true
     | x::xs, y::ys => pred x y && zip_pred pred xs ys
     | _, _ => false
     end.

Lemma list_sum_map :
  forall {X} (f : X -> nat) x xs,
    In x xs ->
    list_sum (map f xs) >= f x.
Proof.
  induction xs; intros In; [contradiction|].
  destruct In; subst.
  - cbn. lia.
  - cbn. specialize (IHxs H).
    unfold list_sum in IHxs.
    lia.
Qed.

Lemma map_In {A B : Type} (l : list A) (f : forall (x : A), In x l -> B) : list B.
Proof.
  induction l.
  - exact nil.
  - refine (f a _ :: IHl _).
    + simpl. auto.
    + intros x H. apply (f x). simpl. auto.
Defined.

Fixpoint zipwith {X Y Z} (f : X -> Y -> Z) (xs : list X) (ys : list Y) : list Z
  := match xs, ys with
     | (x :: xs), (y :: ys) => f x y :: (zipwith f xs ys)
     | _, _ => nil
     end.

Fixpoint addIndices' {A} (i : N) (l : list A) : list (N * A)
  := match l with
     | nil => nil
     | (x::xs) => (i,x) :: addIndices' (N.succ i) xs
     end.

Definition addIndices {A} := @addIndices' A 0.


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

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

Fixpoint plus (a b :nat) : nat :=
  match a, b with
    | O, n => n
    | (S m) , n => (plus m (S n))
  end.
Fixpoint muti (a b :nat) : nat :=
  match a, b with
    | O, _ => O
    | (S n) , m => (plus m (muti n m))
  end.
Fixpoint factorial (n : nat) : nat :=
  match n with
    | O => S O
    | S x => muti (S x) (factorial x)
  end.

Example test_factorial1: (factorial (S (S (S O)))) = S (S (S (S (S (S O))))).
reflexivity. Qed.

Fixpoint add (n : nat) : nat :=
  (S n).

x


Require Import Arith.
Definition f x := x + 100.
Definition g x := x - 100.
Compute f 10.

Theorem g_f : forall x, g (f x) = x.
Proof.
intros.
unfold f, g.
SearchRewrite(_ + _ - _).
rewrite Nat.add_sub.
reflexivity.
Qed.

Require Import List.
Import ListNotations.

Fixpoint reverse {A : Type} (xs : list A) :=
  match xs with
  | nil => nil
  | x :: xs' =>
    reverse xs' ++ [x]
  end.
Compute reverse [1;2;3].

Lemma reverse_append : forall (A:Type) (xs ys:list A),
  reverse (xs ++ ys) = reverse ys ++ reverse xs.
Proof.
  intros A xs ys.
  induction xs.
  - simpl.
  SearchRewrite(_ ++ []).
  rewrite app_nil_r.
  reflexivity.
  - simpl.
  rewrite IHxs.
  SearchRewrite((_ ++ _) ++ _).
  rewrite app_assoc_reverse.
  reflexivity.
Qed.

Theorem reverse_reverse : forall (A : Type) (xs: list A),
  reverse (reverse xs) = xs.
Proof.
  intros A xs.
  induction xs.
  -
  simpl.
  reflexivity.
  -
  simpl.
  rewrite reverse_append.
  rewrite IHxs.
  simpl.
  reflexivity.
Qed.


Require Import ZArith.
Require Import ZArith.Zmax.
Require Import ssr.ssreflect.

Open Scope Z_scope.

Section BinaryTree.

Inductive Tree : Set :=
| leaf : Tree
| node : Tree -> Tree -> Tree.

Definition max := Z.max.

Fixpoint height (t : Tree) : Z :=
match t with
| leaf => 0
| node t1 t2 => 1 + (max (height t1) (height t2))
end.

Fixpoint numleaves (t : Tree) : Z :=
match t with
| leaf => 1
| node t1 t2 => numleaves t1 + numleaves t2
end.

Inductive complete : Tree -> Prop :=
| complete_leaf : complete leaf
| complete_node :
    forall t1 t2,
      complete t1 ->
      complete t2 ->
      height t1 = height t2 ->
      complete (node t1 t2).

Lemma height_nonnegative : forall t, height t >= 0.
Proof.
elim => //=.
move => t1 Ht1 t2 Ht2.
have H0: height (node t1 t2) = 1 + max (height t1) (height t2) by auto.
have H1: height t1 <= max (height t1) (height t2) by apply Z.le_max_l.
have H2: 1 + max (height t1) (height t2) >= 0 by auto with zarith.
by [].
Qed.

Theorem complete_numleaves_height : forall t, complete t -> numleaves t = 2^(height t).
Proof.
elim => //=.
move => t1 IHt1 t2 IHt2 Hc.
have H1: complete t1 by inversion Hc.
have H2: complete t2 by inversion Hc.
have H3: (height t1 = height t2) by inversion Hc; auto.
apply IHt1 in H1.
apply IHt2 in H2.
have H6: (1 >= 0) by intuition.
have H7: (height t1 >= 0) by apply height_nonnegative.
have H8: (height t1 = max (height t1) (height t1)) by erewrite Zmax_idempotent.
simpl numleaves.
rewrite H1 H2.
rewrite -H3.
have Hh: 2 ^ height t1 + 2 ^ height t1 = (2 * 2^(height t1)) by auto with zarith.
rewrite Hh.
have Hh': (2 * 2^(height t1)) = (2^1 * 2^(height t1)) by auto with zarith.
rewrite Hh'.
have Hh'': 2^(1 + height t1) = (2^1 * 2^(height t1)).
  by apply (Zpower_exp 2 1 (height t1) H6 H7).
by rewrite -Hh'' {1}H8.
Qed.

End BinaryTree.


Require Import Arith.
Require Import Omega.
Require Import Psatz.

Require Import kernel_numeric.
Require Import kernel_graph.

(**
Let us define some graphs.
**)

(* Empty graph on [n] vertices *)
Definition Empty (n : nat) : Graph.
Proof.
  refine {| V := n ;
            E := (fun x y => False)
         |} ; auto.
Defined.

(* Complete graph on [n] vertices *)
Definition K (n : nat) : Graph.
Proof.
  refine {| V := n ;
            E := (fun x y => x <> y)
         |}.
  - intros.
    destruct (Nat.eq_dec x y) ; tauto.
  - intros x H L.
    absurd (x = x) ; tauto.
  - intros ; now apply not_eq_sym.
Defined.

(* Path on [n] vertices. *)
Definition Path (n : nat) : Graph.
Proof.
  (* We will do this proof very slowly by hand to practice. *)
  refine {| V := n ;
            E := fun x y => S x = y \/ x = S y
         |}.
  - intros.
    destruct (eq_nat_dec (S x) y).
    + tauto.
    + destruct (eq_nat_dec x (S y)).
      * tauto.
      * { right.
          intros [ ? | ? ].
          - absurd (S x = y) ; assumption.
          - absurd (x = S y) ; assumption.
        }
  - (* This case we do by using a powerful tactic "firstorder".
       We tell it to use the statement [n_Sn] from the [Arith] library.
       To see what [n_Sn] is, run command [Check n_Sn].
       To find [n_Sn], we ran the command [Search (?m <> S ?m)]. *)
    firstorder using n_Sn.
  - intros ? ? ? ? [?|?].
    + right ; now symmetry.
    + left; now symmetry.
Defined.

(* [Cycle n] is the cycle on [n+3] vertices. We define it in a way
    which avoids modular arithmetic. *)
Definition Cycle (n : nat) : Graph.
Proof.
  refine {| V := 3 + n ; (* Do not forget: we have [3+n] vertices 0, 1, ..., n+2 *)
            E := fun x y =>
                 ((S x = y \/ x = S y) \/ (x = 0 /\ y = 2 + n) \/ (x = 2 + n /\ y = 0))
         |}.
  - intros.
    destruct (eq_nat_dec (S x) y); auto.
    destruct (eq_nat_dec x (S y)); auto.
    destruct (eq_nat_dec x 0); destruct (eq_nat_dec y (2 + n)); auto;
    destruct (eq_nat_dec y 0); destruct (eq_nat_dec x (2 + n)); tauto.
  - intros ? ? H.
    destruct H as [[?|?]|[[? ?]|[? ?]]].
    + firstorder using Nat.neq_succ_diag_l.
    + firstorder using Nat.neq_succ_diag_r.
    + apply (Nat.neq_succ_0 (S n)) ; transitivity x.
      * now symmetry.
      * assumption.
    + apply (Nat.neq_succ_0 (S n)) ; transitivity x.
      * now symmetry.
      * assumption.
  - intros ? ? ? ? [[?|?]|[[? ?]|[? ?]]].
    + left; right; now symmetry.
    + left; left; now symmetry.
    + auto.
    + auto.
Defined.


(* 有限な等差級数（等差数列の和）の「公式」を証明する。 *)
(*
   以下の式を証明する。
   Sum(n) = Σ(i=0, n) = 0 + 1 + ... + n = n * (n + 1) / 2

   ただし、(1/2)は扱い難いので、2倍して、以下を証明する。
   Sum2(n) = 2 * Σ(i=0, n) = 2 * (0 + 1 + ... + n) = n * (n + 1)
   *)

(*****************************************************************
   0以上の自然数と、その足し算と掛け算を定義する。
   ***************************************************************)
Inductive nat : Type :=
  | O : nat                                 (* Oは0 *)
  | S : nat -> nat.                         (* Sは後者関数 *)

Fixpoint plus (n : nat) (m : nat) : nat :=
  match n with
    | O => m
    | S n' => S (plus n' m)
  end.
Notation "x + y" := (plus x y)  (at level 50, left associativity) : nat_scope.

Fixpoint mult (n m : nat) : nat :=
  match n with
    | O => O
    | S n' => plus m (mult n' m)
  end.
Notation "x * y" := (mult x y)  (at level 40, left associativity) : nat_scope.
(* 自然数の定義、おわり *)

(*****************************************************************
   等差数列の和の帰納的定義
   Sum(0) = 0
   Sum(n + 1) = Sum(n) + (n + 1)

   実際は2倍のほうを使う。
   Sum2(0) = 0
   Sum2(n + 1) = Sum2(n) + 2*(n + 1)
   ***************************************************************)
(* issum n s は、0からnまでの（等差数列の）総和がsであることを示す。 *)
Inductive issum : nat -> nat -> Prop :=
| Sum_0 : issum O O                         (* 0までの総和は0 *)
| Sum_N :
  forall (n s : nat), issum n s ->          (* nまでの総和がsなら、*)
    issum (S n) (S n + s).                  (* n+1までの総和は(n+1)+s *)

(* issum2 n s は、0からnまでの（等差数列の）総和の2倍がsであることを示す。 *)
Inductive issum2 : nat -> nat -> Prop :=
| Sum2_0 : issum2 O O
| Sum2_N :
  forall (n s : nat), issum2 n s -> issum2 (S n) (S n + S n + s).
(* 等差数列の和の定義、終わり *)

(*****************************************************************
   自然数の足し算と掛け算の法則のうち必要なものを泥縄式に証明する。
   ***************************************************************)
Theorem plus_n_Sm : forall n m,
  S (m + n) = m + S n.
Proof.
  intros n m.
  induction m as [| m'].
  simpl.
  reflexivity.
  simpl.
  rewrite IHm'.
  reflexivity.
Qed.

Theorem plus_swap : forall n m p : nat,
  n + (m + p) = m + (n + p).
Proof.
  intros n m p.
  induction n as [| n'].
  simpl.
  reflexivity.

  simpl.
  rewrite <- plus_n_Sm.
  f_equal.
  apply IHn'.
Qed.

Theorem plus_assoc : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof.
  intros n m p.
  induction n as [| n'].
  reflexivity.
  simpl.
  rewrite -> IHn'.
  reflexivity.
Qed.

Theorem mult_n_Sm : forall n m,
  n + n * m = n * S m.
Proof.
  intros n m.
  induction n as [| n'].
  simpl.
  reflexivity.
  simpl.
  f_equal.
  rewrite <- IHn'.
  apply plus_swap.
Qed.

Theorem mult_develop : forall n m,
  S n + m + n * m  = S n * S m.
Proof.
  intros n m.
  simpl.
  f_equal.
  rewrite <- mult_n_Sm.
  rewrite <- plus_swap.
  rewrite plus_assoc.
  reflexivity.
Qed.
(* 自然数の足し算と掛け算の法則、終わり *)

(*****************************************************************
   等差数列の和の（帰納的、繰り返し的）定義と、いわゆる「公式」が一致す
   ることを証明する。
   Sum(n) = n * (n + 1) / 2

   実際は、2倍して証明する。
   Sum2(n) = n * (n + 1)
   ***************************************************************)
Theorem sum_of_arith_progress : forall n,
  issum2 n (n * S n).
Proof.
  intros n.

  (* nについての帰納法をおこなう。*)
  induction n as [| n'].

  (* n = 0 を証明する。 *)
  (* issum2 O (O * S O) *)
  simpl.                              (* β簡約する。 *)
  apply Sum2_0.                       (* 帰納的定義のSum2_0と同じ。 *)

  (* n = n' が成立するとして、n = S n' を証明する。 *)
  (* issum2 n' (n' * S n') ならば、issum2 (S n') (S n' * S (S n')) *)
  rewrite <- mult_develop.  (* 足し算と掛け算の変形をする。 *)
  apply Sum2_N.             (* 帰納的定義のSum2_Nを使って変形する。 *)
  apply IHn'.               (* 帰納法の仮定とおなじ。 *)
Qed.

(* [] *)


Require Import Coq.Arith.Arith.
Require Import Coq.Arith.Max.
Require Import Coq.omega.Omega.
Require Import Coq.Lists.List.

Lemma beq_nat_sym :
  forall n1 n2, beq_nat n1 n2 = beq_nat n2 n1.
Proof.
  induction n1; destruct n2; simpl; auto.
Qed.

Lemma max_0 :
  forall n1 n2, max n1 n2 = 0 -> n1 = 0 /\ n2 = 0.
Proof.
  intros ; induction n1.
  auto.
  simpl in *|-*.
  destruct n2.
  inversion H.
  inversion H.
Qed.

Lemma plus_minus:
  forall (m n p:nat), n <= p -> m+p-n = m+(p-n).
Proof.
  induction m ; intros.
  omega.
  omega.
Qed.

Lemma plus_minus_n:
  forall (m n:nat), m+n-n = m.
Proof.
  induction m ; intros.
  omega.
  omega.
Qed.

Module List2.

  Definition hd_cons {T:Type} (l:list T) (e:T) : T * list T :=
    match l with
    | nil => (e, nil)
    | e :: l => (e, l)
    end.

  Fixpoint map_iter {T T':Type} (f:T -> nat -> T') (l:list T) (n:nat) :=
    match l with
    | nil => nil
    | cons e l => (f e n) :: map_iter f l (S n)
    end.

End List2.

Module List2Properties.

  Import List2.

  Lemma length_map_iter:
    forall {T T':Type} (f:T -> nat -> T') (l:list T) (n:nat),
    length (map_iter f l n) = length l.
  Proof.
    induction l ; simpl ; intros ; auto.
  Qed.

  Lemma map_iter_app:
    forall {T T':Type} (f:T -> nat -> T') (l1 l2:list T) (n:nat),
    map_iter f (l1++l2) n = (map_iter f l1 n)++(map_iter f l2 (n+(length l1))).
  Proof.
    induction l1 ; simpl ; intros ; auto.
    rewrite IHl1.
    rewrite plus_Snm_nSm.
    reflexivity.
  Qed.

  Lemma map_iter_nth:
    forall {T T':Type} (f:T -> nat -> T') (l:list T) (m n:nat) (e:T),
    nth m (map_iter f l n) (f e (m+n)%nat) = f (nth m l e) (m+n)%nat.
  Proof.
    induction l ; simpl ; intros.
    destruct n ; destruct m ; reflexivity.
    destruct m.
    reflexivity.
    simpl.
    specialize (IHl m (S n)).
    rewrite <- plus_Snm_nSm in IHl.
    rewrite IHl.
    reflexivity.
  Qed.

  Lemma map_iter_nth_indep:
    forall {T T':Type} (f:T -> nat -> T') (l:list T) (m n:nat) (e1:T) (e2:T'),
    m < length l ->
    nth m (map_iter f l n) e2 = f (nth m l e1) (m+n)%nat.
  Proof.
    intros.
    rewrite nth_indep with (d':=f e1 (m+n)%nat).
    apply map_iter_nth.
    rewrite length_map_iter.
    assumption.
  Qed.

End List2Properties.


(* A sorting example :
   (C) Yves Bertot, Pierre Castéran
*)

Require Import List.
Require Import ZArith.
Open Scope Z_scope.

Fixpoint insert (z:Z) (l:list Z) {struct l} : list Z :=
  match l with
  | nil => z :: nil
  | cons a l' => if Z.leb z a
      then z :: a :: l'
      else a :: insert z l'
 end.

Compute  insert 4 (2 :: 5 :: nil).

Compute insert 4 (24 :: 50 ::nil).

Fixpoint insertion_sort (l:list Z) : list Z :=
match l with
| nil => nil
| z::l' => insert z (insertion_sort l')
end.

Compute insertion_sort (4::9::7::9::12::3::nil).

Inductive sorted : list Z -> Prop :=
  | sorted0 : sorted nil
  | sorted1 : forall z:Z, sorted (z :: nil)
  | sorted2 :
      forall (z1 z2:Z) (l:list Z),
        z1 <= z2 ->
        sorted (z2 :: l) -> sorted (z1 :: z2 :: l).

Hint Resolve sorted0 sorted1 sorted2 : sort.

Lemma sort_2357 :
 sorted (2 :: 3 :: 5 :: 7 :: nil).
Proof.
 auto with sort zarith.
Qed.

Theorem sorted_inv :
 forall (z:Z) (l:list Z), sorted (z :: l) -> sorted l.
Proof.
 intros z l H.
 inversion H; auto with sort.
Qed.

(*  Number of occurrences of z in l *)

Check Z.eqb.

Fixpoint nb_occ (z:Z) (l:list Z) {struct l} : nat :=
  match l with
  | nil => 0%nat
  | (z' :: l') =>
      if Z.eqb z z'
      then S (nb_occ z l')
      else nb_occ z l'
   end.

Eval compute in (nb_occ 3 (3 :: 7 :: 3 :: nil)).

Eval compute in (nb_occ 36725 (3 :: 7 :: 3 :: nil)).

(* list l' is a permutation of list l *)

Definition equiv (l l':list Z) :=
    forall z:Z, nb_occ z l = nb_occ z l'.

(* equiv is an equivalence ! *)

Lemma equiv_refl : forall l:list Z, equiv l l.
Proof.
 unfold equiv; trivial.
Qed.

Lemma equiv_sym : forall l l':list Z, equiv l l' -> equiv l' l.
Proof.
  unfold equiv; auto.
Qed.

Lemma equiv_trans :
 forall l l' l'':list Z, equiv l l' ->
                         equiv l' l'' ->
                         equiv l l''.
Proof.
 intros l l' l'' H H0 z.
 eapply trans_eq; eauto.
Qed.

Lemma equiv_cons :
 forall (z:Z) (l l':list Z), equiv l l' ->
                             equiv (z :: l) (z :: l').
Proof.
 intros z l l' H z'.
 simpl; case_eq  (Z.eqb z' z); auto.
Qed.

Lemma equiv_perm :
 forall (a b:Z) (l l':list Z),
   equiv l l' ->
   equiv (a :: b :: l) (b :: a :: l').
Proof.
 intros a b l l' H z; simpl.
 case_eq (Z.eqb z a); case_eq (Z.eqb z b);
  simpl; case (H z); auto.
Qed.

Hint Resolve equiv_cons equiv_refl equiv_perm : sort.

(* insertion of z into l at the right place
   (assuming l is sorted)
*)

(** Correlation between Z.leb and Z.le *)

SearchAbout (Z.leb _ _ = true).
(*
Zle_bool_imp_le: forall n m : Z, (n <=? m) = true -> n <= m
Zle_imp_le_bool: forall n m : Z, n <= m -> (n <=? m) = true
...
Z.leb_le: forall n m : Z, (n <=? m) = true <-> n <= m
*)
SearchAbout (Z.leb _ _ = false).

Ltac le_from_bool := repeat (rewrite Z.leb_le in * || rewrite Z.leb_gt in *).
(** Z.leb_gt: forall x y : Z, (x <=? y) = false <-> y < x *)

(* the insert function seems to be a good tool for sorting ... *)

Lemma insert_equiv : forall (l:list Z) (x:Z),
                  equiv (x :: l) (insert x l).
Proof.
 induction l as [|a l0 H]; simpl ; auto with sort.
 intros x; case_eq (Z.leb x a);
   simpl; auto with sort.
  intro; apply equiv_trans with (a :: x :: l0);
   auto with sort.
Qed.

Lemma insert_sorted :
 forall (l:list Z) (x:Z), sorted l -> sorted (insert x l).
Proof.
  intros l x H; elim H; simpl; auto with sort.
  -  intro z; case_eq (Z.leb x z); simpl; intros;
     le_from_bool;  auto with sort zarith.
  -  intros z1 z2; case_eq (Z.leb x z2); simpl; intros;
     case_eq (Z.leb x z1);intros; le_from_bool;  auto with sort zarith.
Qed.

Lemma sort_equiv : forall l, equiv l (insertion_sort l).
Proof.
 induction l;simpl;auto with sort.
 SearchAbout equiv.
apply equiv_trans with (a:: insertion_sort l).
 apply equiv_cons;auto.
 apply insert_equiv.
Qed.

Lemma sort_sorted : forall l, sorted (insertion_sort l).
induction l;simpl;auto with sort.
now apply insert_sorted.
Qed.

Lemma sort_sorted : forall l, sorted (insertion_sort l).
induction l;simpl;auto with sort.
now apply insert_sorted.
Qed.

Extraction "insert-sort" insert insertion_sort.

(**

 Projet :

 Specifier de la facon la plus generique possible ce qu'est une fonction
 correcte de tri polymorphe sur des listes:

 Construire une version polymorphe du tri par insertion, et prouver qu'elle
 realise la specification ci-dessus

 Afin d'illustrer la genericite de votre construction, montrer qu'elle
 permet de trier des listes de divers types de  données, et comment
 realiser les transformations suivantes :
  + tri par ordre decroissant
  + tri sur un produit lexicographique
  + tri selon les valeurs d'une fonction

*)


Module MYIFF.

Definition iff (P Q:Prop) : Prop := (P -> Q) /\ (Q -> P).
Notation "P <-> Q" := (iff P Q) (at level 95, no associativity) (* : type_scope *).

End MYIFF.

Theorem iff_sym : forall (P Q:Prop),
    (P <-> Q) -> (Q <-> P).
Proof. intros P Q [H1 H2]. split. exact H2. exact H1. Qed.

Lemma not_true_iff_false : forall (b:bool),
    b <> true <-> b = false.
Proof.
    intros b. destruct b.
    - split.
        + intros H. exfalso. apply H. reflexivity.
        + intros H. inversion H.
    - split.
        + intros. reflexivity.
        + intros H1 H2. inversion H2.
Qed.

Theorem iff_refl : forall (P:Prop),
    P <-> P.
Proof.
    intros P. split.
    - intros H. exact H.
    - intros H. exact H.
Qed.

Theorem iff_trans : forall (P Q R:Prop),
    (P <-> Q) -> (Q <-> R) -> (P <-> R).
Proof.
    intros P Q R [Hpq Hqp] [Hqr Hrq]. split.
    - intro Hp. apply Hqr. apply Hpq. exact Hp.
    - intro Hr. apply Hqp. apply Hrq. exact Hr.
Qed.

Theorem or_distributes_over_and : forall (P Q R:Prop),
    P \/ (Q /\ R) <-> (P \/ Q) /\ (P \/ R).
Proof.
    intros P Q R. split.
    - intros [Hp|[Hq Hr]].
        + split. { left. exact Hp. } { left. exact Hp. }
        + split. { right. exact Hq. } { right. exact Hr. }
    - intros [[H1|Hq] [H2|Hr]].
        + left. exact H1.
        + left. exact H1.
        + left. exact H2.
        + right. split. { exact Hq. } { exact Hr. }
Qed.


Example test (b1 :bool) : true = true.
Admitted.

(*https://people.inf.elte.hu/akaposi/fsz/*)
Definition negb (b:bool) : bool :=
  match b with
  | true => false
  | false => true
  end.
Definition andb (b1:bool) (b2:bool) : bool :=
  match b1 with
  | true => b2
  | false=> false
  end.
Definition orb (b1:bool) (b2:bool) : bool :=
  match b1 with
  | true => true
  | false => b2
  end.

Notation "x && y" := (andb x y)
  (at level 50, left associativity).

Example negneg (b : bool) : negb (negb b) = b.
intros c.
destruct c.
simpl.
reflexivity.
simpl.
reflexivity.
Qed.
(* More basic tactics computer foundation *)

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

Definition isOne (n : Nat) : bool :=
  match n with
  | O => false
  | S O => true
  | _ => false
  end.

Definition four : Nat := S (S (S (S O))).
Definition six : Nat := S(S four).
Eval compute in isOne four.
Eval compute in isOne O.
Eval compute in isOne (S O).

(* Sn * 2 = (1 + n) * 2 = 2 + 2n *)
(* Fixpoint For recursive definiton*)
Fixpoint twice (n : Nat) : Nat :=
 match n with
 | O => O
 | S n => S(S (twice n))
end.

Eval compute in twice six.
(* S n must be less then f n (or swapped :) ) *)
Fixpoint f (n :Nat) : Nat := match n with
 | O => O
 | S n => f n
 end.

(* Fixpoint f (n : Nat) : Nat := f n.*)

(*
  S(S (S O)) + m
  S(S(S O) + m) = <- S n' + m = S(n'+m)
  S(S(S O + m)) =
  S(S(S(O+m))) = <- O + m = m
  S(S(S(M)))
 *)
Fixpoint plus (n m : Nat) {struct n}  : Nat :=
  match n with
  | O => m
  | S n' => S (plus n' m)
  end.

Eval compute in plus (twice six) (twice four).

Notation "x + y" := (plus x y)
  (at level 50, left associativity).

Lemma leftid (n : Nat) : O + n = n.
simpl.
reflexivity.
Qed.

Lemma rightid (n : Nat) : n + O = n.
simpl.
induction n as [|m H].
reflexivity.
simpl.
(* swap m + O to m // <- swap m to m + O*)
rewrite -> H.
reflexivity.
Qed.
(* profe associativity for NAT*)


Require Import nat.
Require Import bool.
Require Import induction.

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

Theorem silly3' : forall (n:nat),
    (eqb n 5 = true -> eqb (S (S n)) 7 = true) ->
    true = eqb n 5 ->
    true = eqb (S (S n)) 7.
Proof.
    intros n H1 H2. symmetry in H2. apply H1 in H2.
    symmetry in H2. exact H2.
Qed.

Theorem plus_n_n_injective : forall (n m:nat),
    n + n = m + m -> n = m.
Proof.
    induction n as [|n H].
    - intros m H. destruct m as [|m].
        + reflexivity.
        + simpl in H. inversion H.
    - intros m H'. destruct m.
        + simpl in H'. inversion H'.
        + simpl in H'. inversion H' as [H1]. clear H'.
            rewrite (plus_comm n (S n)) in H1.
            rewrite (plus_comm m (S m)) in H1.
            simpl in H1. inversion H1 as [H']. clear H1.
            apply H in H'. rewrite H'. reflexivity.
Qed.


Module fmcthanos.

Inductive Nat : Type :=
  | O
  | S (n : Nat).

Fixpoint plus (n m : Nat) : Nat :=
  match m with
  | O => n
  | S m => S (plus n m)
  end.
Notation "x + y" := (plus x y).

(** Exercício x4.3 *)
Compute O + S(S(S(S O))).

(** Exercício x4.4 *)
Compute S(S(S O)) + S(S O).
Compute (S(S(S O)) + S(S O)) + S O.

(** Exercício x4.5 *)
Fixpoint double (n : Nat) : Nat :=
  n + n.

(** Exercício x4.6 *)
Fixpoint mult (n m : Nat) :=
  match m with
  | O => O
  | S m => (mult n m) + n
  end.
Notation "x * y" := (mult x y).

(** Exercício x4.7 *)
Compute S(S O) * (O + S O).

(** Exercício x4.8 *)
Compute S(S O) * S(S(S O)).
Compute S(S(S O)) * S(S O).

(** Exercício x4.9 *)
Fixpoint power (n m : Nat) : Nat :=
  match m with
  | O => S O
  | S m => (power n m) * n
  end.
Notation "x ^ y" := (power x y).

(** Exercício x4.10 *)
Compute S(S O) ^ S(S(S O)).

(** Exercício x4.11 *)
Fixpoint fib (n : Nat) : Nat :=
  match n with
  | O => O
  | S O => S O
  | S(S n as n') => fib (n') + fib (n)
  end.

Compute fib (S O).
Compute fib (S(S O)).
Compute fib (S(S(S O))).
Compute fib (S(S(S(S O)))).

Theorem plus_assoc :
forall (a m y : Nat), (a + m) + y = a + (m + y).
Proof.
  intros a m y.
  induction y as [ | z].
  - simpl.
    reflexivity.
  - simpl.
    rewrite -> IHz.
    reflexivity.
Qed.

Lemma plus_Sa_b :
forall (a b : Nat), S a + b = a + S b.
Proof.
  intros a b.
  induction b as [ | c].
  - simpl.
    reflexivity.
  - simpl.
    rewrite -> IHc.
    simpl.
    reflexivity.
Qed.

Theorem plus_comm :
forall (n m : Nat), n + m = m + n.
Proof.
  intros n m.
  induction n as [ | t].
  - induction m as [ | u].
    + reflexivity.
    + simpl.
      rewrite -> IHu.
      simpl.
      reflexivity.
  - rewrite -> plus_Sa_b.
    simpl.
    rewrite -> IHt.
    reflexivity.
Qed.

(** Exercício x4.16 *)
Theorem mult_distr :
forall (x y z : Nat), x * (y + z) = (x * y) + (x * z).
Proof.
  intros x y z.
  induction z as [ | z'].
  - simpl.
    reflexivity.
  - simpl.
    rewrite -> IHz'.
    rewrite <- plus_assoc.
    reflexivity.
Qed.

(** Exercício x4.14 *)
Theorem mult_assoc :
forall (n m k : Nat), (n * m) * k = n * (m * k).
Proof.
  intros n m k.
  induction k as [ | k'].
  - simpl.
    reflexivity.
  - simpl.
    rewrite -> IHk'.
    rewrite <- mult_distr.
    reflexivity.
Qed.

(** Extra *)
Lemma mult_SO_a :
forall (a : Nat), S O * a = a.
Proof.
  intro a.
  induction a as [ | x].
  - simpl.
    reflexivity.
  - simpl.
    rewrite -> IHx.
    reflexivity.
Qed.

(** Exercício x4.15 *)
Lemma Sn_m :
forall (n t : Nat), S t * n = (t * n) + n.
Proof.
  intros n m.
  induction n as [ | x].
  - simpl.
    reflexivity.
  - simpl.
    rewrite -> IHx.
    rewrite -> plus_assoc.
    rewrite -> plus_assoc.
    rewrite <- (plus_comm m x).
    reflexivity.
Qed.

Theorem mult_comm :
forall (n m : Nat), n * m = m * n.
Proof.
  intros n m.
  induction m as [ | t].
  - induction n as [ | u].
    + reflexivity.
    + simpl.
      rewrite <- IHu.
      simpl.
      reflexivity.
  - simpl.
    rewrite -> Sn_m.
    rewrite -> IHt.
    reflexivity.
Qed.

Definition leq (n m : Nat) : Prop :=
exists (k : Nat), n + k = m.
Notation "x <= y" := (leq x y).

(** Exercício x4.20 *)
Example leq_or_equal_1 :
forall (n m : Nat), (n <= S m) -> (n <= m \/ n = S m).
Proof.
  intros n m.
  intro Hnlsm.
  destruct Hnlsm as [k Hk].
  destruct k as [ | k'].
  - right.
    assumption.
  - left.
    simpl in Hk.
    exists k'.
    inversion Hk.
    reflexivity.
Qed.

Example leq_or_equal_2 :
forall (n m : Nat), (n <= m \/ n = S m) -> (n <= S m).
Proof.
  intros n m.
  intro Hnmnsm.
  destruct Hnmnsm as [Hnm | Hnsm].
  - destruct Hnm as [k Hk].
    exists (S k).
    simpl.
    inversion Hk.
    reflexivity.
  - exists O.
    simpl.
    assumption.
Qed.

(** Exercício x4.21 *)
Theorem leq_refl :
forall (x : Nat), x <= x.
Proof.
  intro x.
  exists O.
  simpl.
  reflexivity.
Qed.

(** Exercício x4.22 *)
Theorem leq_trans :
forall (x y z: Nat), (x <= y) /\ (y <= z) -> x <= z.
Proof.
  intros x y z.
  unfold leq.
  intro Hxyyz.
  destruct Hxyyz as [Hxy Hyz].
  destruct Hxy as [k Hk].
  destruct Hyz as [k' Hk'].
  rewrite <- Hk in Hk'.
  exists (k + k').
  rewrite <- Hk'.
  rewrite -> plus_assoc.
  reflexivity.
Qed.

(** Exercício x4.23 *)
Lemma x_diff :
forall (x y : Nat), x <> x + S y.
Proof.
  intros x y.
  unfold not.
  induction x as [ | w].
  - intro Hxxsy.
    rewrite -> plus_comm in Hxxsy.
    simpl in Hxxsy.
    inversion Hxxsy.
  - intro Hswswsy.
    rewrite -> plus_comm in Hswswsy.
    simpl in Hswswsy.
    inversion Hswswsy as [Hwsyw].
    rewrite -> plus_comm in Hwsyw.
    apply (IHw Hwsyw).
Qed.

Lemma y_equality :
forall (x y : Nat), x + y = x -> y = O.
Proof.
  intros x y.
  intro Hxyx.
  destruct y as [ | y'].
  - reflexivity.
  - simpl in Hxyx.
    destruct x as [ | x'].
    + inversion Hxyx.
    +

(*
   induction x as [ | x'].
    + simpl in Hxyx.
      discriminate.
    + rewrite -> IHy' in IHx'. *)
(*       * discriminate. *)
Abort.

Lemma xaxbab :
forall (x a b : Nat), a + x = b + x -> a = b.
Proof.
  intros x a b.
  intro Hxaxb.
  induction x as [ | x'].
  - assumption.
  - rewrite <- IHx' in Hxaxb.
    simpl in Hxaxb.
Abort.

Lemma abo :
forall (a b : Nat), a + b = O -> a = O /\ b = O.
Proof.
  intros a b Habo.
  destruct b as [ | b'].
  - split.
    + simpl in Habo.
      assumption.
    + reflexivity.
  - simpl in Habo.
    discriminate.
Qed.

Theorem leq_antisym :
forall (x y: Nat), (x <= y) /\ (y <= x) -> x = y.
Proof.
  intros x y.
  intro Hxyyx.
  destruct Hxyyx as [Hxy Hyx].
  destruct Hxy as [w Hw].
  destruct Hyx as [v Hv].
  rewrite <- Hw in Hv.
  induction y as [ | y'].
  - induction x as [ | x'].
    + induction w as [ | w'].
      * reflexivity.
      * reflexivity.
    + rewrite -> plus_comm in Hw.
      simpl in Hw.
      discriminate.
  - induction x as [ | x''].
    + induction w as [ | w''].
      * simpl in Hw.
        discriminate.
      * rewrite -> plus_comm in Hv.
        simpl in Hv.
        discriminate.
    + induction w as [ | w'''].
      * rewrite -> plus_comm in Hw.
        simpl in Hw.
        rewrite -> plus_comm in Hw.
        simpl in Hw.
        assumption.
      * induction v as [ | v'].
        simpl in Hv.
        -- rewrite Hv.
           reflexivity.
        --
        rewrite -> plus_comm in H.

  induction w as [ | u].
  - reflexivity.
  - pattern x at 1. rewrite <- Hv.
    induction v as [ | t].
    + rewrite -> Hw.
      reflexivity.
    + rewrite <- Hw in Hv.
      rewrite -> plus_assoc in Hv.
      simpl (S u + S t) in Hv.
      induction x as [ | s].
      * simpl in Hv.
        discriminate.
      *

    destruct x as [ | Su].
    + rewrite -> plus_comm.
      simpl.
      discriminate.

    rewrite -> plus_assoc.
    reflexivity.
  - destruct Hxyyz as [Hxy Hyz].
    destruct Hxy as [k Ek].
    destruct Hyz as [k' Ek'].
    destruct Hxz as [k'' Ek''].
    rewrite <- Ek'.
    rewrite <- Ek.
(*     rewrite <- Ek. *)
Abort.

(** Exercício x4.24 *)
Theorem leq_total :
forall (x y: Nat), (x <= y) \/ (y <= x).
Proof.
  intros x y.
  destruct y as [ | y'].
  - destruct x as [ | x'].
    + left.
      exists O.
      reflexivity.
    + right.
      exists (S x').
      rewrite -> plus_comm.
      simpl.
      reflexivity.
  - induction x as [ | x'].
    + left.
      exists (S y').
      rewrite -> plus_comm.
      simpl.
      reflexivity.
    + destruct IHx' as [Hx'sy' | Hsy'x'].
      destruct Hx'sy' as [w Hw].
      destruct w as [ | w'].
      * rewrite <- Hw.
        right.
        exists (S O).
        simpl.
        reflexivity.
      * rewrite <- Hw.
        left.
        exists w'.
        rewrite -> plus_comm.
        simpl.
        rewrite -> plus_comm.
        reflexivity.
      * destruct Hsy'x' as [v Hv].
        right.
        exists (S v).
        simpl.
        rewrite -> Hv.
        reflexivity.
Qed.

(** Exercício x4.25 *)
(* Example n2_leq_2n :
forall (n : Nat), S(S(S(S(S O)))) <= n -> n ^ (S(S O)) < S(S O) ^ n.
Admitted. *)

(** Homework: 20/02/2021, 1 *)
Fixpoint sum (i n x : Nat) : Nat :=
  match n with
  | O => O
  | S n' => x + (sum i n' x)
  end.

Compute (sum (S O) (S(S(S O))) (S O)).
Compute (sum (S O) (S(S(S(S(S(S O)))))) (S O)).

Theorem n_equals_sum_3_5 :
forall (n : Nat), exists (t u : Nat), n = S(S(S O)) * t + S(S(S(S(S O)))) * u.
Proof.
  intro n.
  induction n as [ | m].
  - exists O.
    exists O.
    simpl.
    reflexivity.
  - destruct IHm as [v Hv].
    destruct Hv as [w Hw].
    rewrite -> Hw.
    destruct v as [ | x].
    + destruct w as [ | y].
      * simpl.
        exists O.
        exists O.
        simpl.
(*     exists (S(S O)).
    exists (S O). *)
Abort.

Fixpoint sum1 (n : Nat) (s : Nat -> Nat) : Nat :=
  match n with
  | O => O
  | S n' => (s n) + (sum1 n' s)
  end.

Compute (sum1 (S(S(S O))) (fun i => (S O))).
(* Compute (sum1 (S O) (S(S(S(S(S(S O)))))) (S O)). *)

(* Fixpoint sum_natseq (i n : Nat) (x : Nat -> Nat) : Nat :=
  match i with
  | i' => (x i') + (sum_natseq (S i') n x)
  | S n => O
  end. *)

(**  Preciso estudar listas primeiro para definir isso.
  *)

(** (* (* (* (* (* (* Problem Set 1.1 *) *) *) *) *) *) *)

Definition less_than (n m : Nat) : Prop :=
exists (k : Nat), n + S k = m.
Notation "x < y" := (less_than x y).

Example problema_1_1 :
forall (x y : Nat), x <= y -> x < y \/ x = y.
Proof.
  intros x y.
  intro Hxleqy.
  destruct Hxleqy as [k Hk].
  destruct k as [ | k'].
  - simpl in Hk.
    right.
    assumption.
  - left.
    unfold less_than.
    exists k'.
    assumption.
Qed.

Example problema_1_2 :
forall (x y : Nat), x < y \/ x = y -> x <= y.
Proof.
  intros x y.
  intro Hxy.
  destruct Hxy as [Hxlty | Hxeqy].
  - destruct Hxlty as [n Hsn].
    unfold leq.
    exists (S n).
    assumption.
  - exists O.
    simpl.
    assumption.
Qed.

Example problema_1_3 :
forall (x y : Nat), x < y -> x <= y /\ x <> y.
Proof.
  intros x y.
  intro Hxy.
  destruct Hxy as [n Hn].
  split.
  - exists (S n).
    assumption.
  - simpl in Hn.
    destruct y as [ | y'].
    + inversion Hn.
    + injection Hn.
Abort.

Example problema_1_4 :
forall (x y : Nat), x <= y /\ x <> y -> x < y.
Proof.
  intros x y.
  intro xleqy_and_xdiffy.
  destruct xleqy_and_xdiffy as [xleqy xdiffy].
  destruct xleqy as [n defleq].
  destruct n as [ | n'].
  - simpl in defleq.
    contradiction.
  - exists n'.
    assumption.
Qed.

Example problema_2_1 :
forall (a x y : Nat), x <= y -> x ^ a < y ^ a.
Proof.
  intros a x y.
  intro xleqy.
  destruct xleqy as [k existsk].
  rewrite <- existsk.
  induction x as [ | x'].
  - rewrite -> plus_comm.
    simpl.
    destruct k as [ | k'].
  simpl.
Abort.

Example problema_3 :
forall n : Nat,
(exists k : Nat, n = S(S O) * k) \/
(exists k' : Nat, n = S(S(S O) * k')).
Proof.
  intro n.
  induction n as [ | n'].
  - left.
    exists O.
    simpl.
    reflexivity.
  - destruct IHn' as [IHn'1 | IHn'2].
    + right.
      destruct IHn'1 as [m Em].
      exists m.
      rewrite <- Em.
      simpl.
      reflexivity.
    + left.
      destruct IHn'2 as [m Em].
      rewrite -> Em.
      exists (S m).
      simpl.
      reflexivity.
Qed.

End fmcthanos.


Require Import Arith.
Require Import Omega.

(* Chapter 4: Primality *)
Definition divides (a b : nat) :=
  exists q, b = a * q.

Notation "x `div y" := (divides x y) (at level 70).

Definition prime (p : nat) :=
  (p <> 1) /\ (forall x, x `div p -> (x = 1) \/ (x = p)).

Remark one_not_prime: ~ prime 1.
Proof.
intros [h1 h2]; now apply h1.
Qed.

Remark two_is_prime: prime 2.
Proof.
split; [now firstorder | ].
intros x [q hq].
destruct x as [ | [ | [ | x ]]]; try now intuition.
destruct q as [ | q]; [ now rewrite mult_0_r in hq | ].
simpl in hq.
injection hq; clear hq; intro hq.
rewrite Nat.add_succ_r in hq.
injection hq; clear hq; intro hq.
now rewrite !Nat.add_succ_r in hq.
Qed.

Lemma divides_refl: forall n, n `div n.
Proof.
intro n; exists 1.
now rewrite mult_1_r.
Qed.

Lemma divides0: forall n, n `div 0.
Proof.
now intro n; eexists; eauto.
Qed.

Remark eq1: forall a b, 1 = a * b -> a = 1 /\ b = 1.
Proof.
intros [ | [ | a]] [ | [ | b]] h; simpl in *;
  try solve [discriminate | firstorder ].
Qed.

Lemma divides1: forall n, n `div 1 <-> n = 1.
Proof.
intro n; split; intro h.
- destruct h as [ q hq ].
  now apply eq1 in hq as [h1 h2].
- subst.
  apply divides_refl.
Qed.

Lemma divides_trans:forall a b c, a `div b -> b `div c -> a `div c.
Proof.
intros a b c [q hq] [p hp].
rewrite hq in hp.
exists (q * p).
rewrite mult_assoc.
exact hp.
Qed.

Lemma divides_add: forall d a b, d `div a -> d `div b -> d `div (a + b).
Proof.
intros d a b [q hq] [p hp].
exists (q + p).
rewrite hq, hp.
SearchAbout mult.
SearchPattern (_ + _ = _ + _).
rewrite Nat.mul_add_distr_l.
reflexivity.
Qed.

Lemma divides_sub: forall d a b, d `div a -> d `div b -> d `div (a - b).
Proof.
intros d a b [q hq] [p hp].
exists (q - p).
rewrite hq, hp, Nat.mul_sub_distr_l.
reflexivity.
Qed.

Lemma divides_addl: forall d a b, d `div a -> d `div (a + b) -> d `div b.
Proof.
intros d a b ha hab.
replace b with ((a + b) - a).
- apply divides_sub; assumption.
- auto with arith.
Qed.

Lemma divides_lmul: forall d a x, d `div a -> d `div (x * a).
Proof.
intros d a x [q hq].
exists (q * x).
rewrite hq.
now rewrite mult_comm, mult_assoc.
Qed.

Lemma divides_rmul: forall d a x, d `div a -> d `div (a * x).
Proof.
now intros; rewrite mult_comm; apply divides_lmul.
Qed.

Lemma divides_le: forall m n, m `div n -> (m <= n \/ n = 0).
Proof.
intros m n [q hq]; subst.
destruct q as [ | q].
- now right; auto with arith.
- left.
  rewrite mult_succ_r.
  now auto with arith.
Qed.

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

Lemma factorial_non_zero: forall n, factorial n <> 0.
Proof.
induction n as [ | n hi]; simpl in *; intro h; [ discriminate | ].
apply plus_is_O in h as [h _].
now apply hi.
Qed.

Remark le_lt_eq: forall a b, a <= S b -> a = S b \/ a <= b.
Proof.
intros a b h.
inversion h; subst; clear h.
- now left.
- now right.
Qed.

Lemma divides_fact:forall m n, 0 < m -> m <= n ->
  m `div (factorial n).
Proof.
Show Proof.
intros m; induction n as [ | n hi]; simpl in *; intros hlt hle.
Show Proof.
- apply le_n_0_eq in hle; subst.
  Show Proof.
  apply lt_irrefl in hlt.
  elim hlt.
- apply le_lt_eq in hle as [h | h].
  + subst.
    replace (factorial n + n * factorial n) with
       (S n * factorial n) by (auto with arith).
    apply divides_rmul.
    apply divides_refl.
  + apply divides_add.
    * now apply hi.
    * apply divides_lmul.
      now apply hi.
Qed.

Print divides_fact.

(* all prime factors of n! + 1 are > n *)
Lemma prime_div_factor: forall n p, p `div (factorial n + 1) -> prime p -> n < p.
Proof.
intros n p hdiv0 hp.
destruct (lt_dec n p) as [ h | h]; [assumption | ].
assert (hdiv1: p `div factorial n).
- apply divides_fact.
  + destruct p as [ | p].
    * destruct hp as [_ hp].
      now destruct (hp 2 (divides0 2)).
    * now auto with arith.
  + now apply not_lt in h.
- assert (h1: p `div 1) by now apply divides_addl with (factorial n).
  apply divides1 in h1.
  elim one_not_prime.
  now rewrite <- h1.
Qed.

(* for any natural number, there exists a natural number greater than it *)
Lemma euclid_: (forall n, n <> 1 -> exists p, prime p /\ p `div n)
    -> forall n, exists p, n < p /\ prime p.
Proof.
intros hprime_factor n.
destruct (hprime_factor (factorial n + 1)) as [p [hp hd]].
- rewrite plus_comm; intro hf; injection hf; clear hf; intro hf.
  now apply factorial_non_zero in hf.
- exists p; split; [ | assumption ].
  now apply prime_div_factor.
Qed.

(* Let's prove the "prime_factor" part with the excluded middle, so
   we can reason "naturally" by contradiction
 *)
Require Import Wf.

Section WithEM.

Lemma prime_factor_with_EM:
    (forall A: Prop, A \/ ~ A) ->
    forall n, n <> 1 -> exists p, prime p /\ p `div n.
Proof.
intro EM.
induction n as [ n hi ] using (well_founded_induction lt_wf).
case_eq (n =? 0); intros hn0;
  [ intros _; apply Nat.eqb_eq in hn0; subst;
    exists 2; split; [ apply two_is_prime | apply divides0 ] | ].
apply Nat.eqb_neq in hn0.
intros hn1.
destruct (EM (prime n)) as [hp | hp].
- exists n; split; [ assumption | ].
  now apply divides_refl.
- destruct (EM (exists m, 1 < m /\ m < n /\ m `div n)) as [hd | hd ].
  + destruct hd as [d [h0 [h1 h2]]].
    destruct (hi d h1) as [p [hp1 hp2]]; [now intuition | ].
    exists p; intuition.
    now apply divides_trans with d.
  + elim hp; split; [ assumption | intros x hx].
    case_eq (x =? n); intro hxn; [ now apply Nat.eqb_eq in hxn; right | ].
    case_eq (x =? 0); intro hx0.
    * apply Nat.eqb_eq in hx0; subst.
      destruct hx as [ q hq].
      now rewrite hq; right.
    * case_eq (x =? 1); intro hx1.
      -- apply Nat.eqb_eq in hx1; now left.
      -- apply Nat.eqb_neq in hx0.
         apply Nat.eqb_neq in hx1.
         apply Nat.eqb_neq in hxn.
         elim hd.
         exists x; repeat split; [ now intuition | | assumption ].
         now apply divides_le in hx as [hx | hx]; [ intuition | subst; now elim hn0].
Qed.

(* for any natural number, there exists a natural number greater than it *)
Lemma euclid_with_EM: (forall A: Prop, A \/ ~A) ->
    forall n, exists p, n < p /\ prime p.
Proof.
intros hem n.
apply euclid_.
now apply prime_factor_with_EM.
Qed.

End WithEM.

(* Now let's be good intuitionistic lads and do the same without the excluded
   middle. In `prime_factor_with_EM`, we used the EM to test if a natural
   number was prime or not. Let's write some code just to do that.
*)

Section NoEM.
(*
Now let's avoid EM and build a function to test the primality of natural
numbers. We'll do that by writing a function to perform the division
(there's probably a few in the lib, this is for showing how it's done).
*)

(* Write concrete implementation of division (stollen from ssreflect) *)
Fixpoint divn_rec d m q :=
  match m - d with
  | S x => divn_rec d x (S q)
  | _ => (q, m)
  end.

Lemma divn_rec_unroll : forall d m q, divn_rec d m q =
  match m - d with
  | S x => divn_rec d x (S q)
  | _ => (q, m)
  end.
Proof.
now intros d [] q.
Qed.

(* And its specification *)
Lemma divn_rec_spec: forall d m x,
 let (q, r) := divn_rec d m x in m = (q - x) * (S d) + r /\ x <= q /\ r < S d.
Proof.
intro d; induction m as [m hi] using (well_founded_induction lt_wf); intros x; simpl in *.
rewrite divn_rec_unroll.
case_eq (m - d); [ now intros;  rewrite Nat.sub_diag; firstorder | ].
intros md heq.
assert (hlt: md < m) by omega.
specialize hi with md (S x).
destruct divn_rec as [ q r].
replace m with (d + S md) by now apply Nat.add_sub_eq_nz in heq.
destruct (hi hlt) as [ h [hle hr]].
split; [ | split; [now auto with arith | assumption ]].
rewrite h.
replace ((q - x) * S d) with ((q - S x) * S d + S d).
omega.
replace (q - x) with (S (q - S x)) by omega.
rewrite Nat.mul_succ_l.
reflexivity.
Qed.

(* Main function *)
Definition divn m d :=
 match d with
 | 0 => (0, m)
 | S d => divn_rec d m 0
end.

Inductive divn_spec m d : nat * nat -> Type :=
  DivnSpec: forall q r, m = q * d + r -> ((d > 0) -> (r < d)) -> divn_spec m d (q, r).

(* And specification *)
Lemma divn_spec_ok m d : divn_spec m d (divn m d).
Proof.
unfold divn.
destruct d as [ | d]; [ now constructor | ].
pose (hrec := divn_rec_spec d m 0).
case_eq (divn_rec d m 0); intros q r heq.
rewrite heq in hrec; destruct hrec as [h1 [h2 h3]].
constructor.
- now rewrite Nat.sub_0_r in h1.
- now intros.
Qed.

(* We now show that divn is equivalent to divides *)
Lemma divn_div: forall m d,
  d `div m <-> (let (q, r) := divn m d in r = 0).
Proof.
intros m d; split; intro h.
- destruct h as [q hq].
  destruct (divn_spec_ok m d) as [k s heq hrem].
  rewrite mult_comm in heq.
  destruct d as [ | d].
  + now simpl in *; subst.
  + rewrite heq in hq.
    apply Nat.add_sub_eq_l in hq.
    rewrite <- Nat.mul_sub_distr_l in hq.
    case_eq (q - k).
    * intro h; rewrite h in hq.
      now rewrite mult_comm in hq.
    * intros x hx; rewrite hx in hq.
      assert (hn : S d <= s).
      -- replace (S d) with ((S d) * 1) by now rewrite mult_comm, mult_1_l.
         rewrite <- hq.
         apply mult_le_compat_l.
         now auto with arith.
      -- elim (lt_irrefl s).
         apply lt_le_trans with (S d); [ now apply hrem; auto with arith | now apply hn ].
- destruct (divn_spec_ok m d) as [q s heq hrem].
  rewrite heq, h, plus_0_r.
  now exists q; rewrite mult_comm.
Qed.

(* Now let's write an algorithm that tests if a number is prime, by
   testing all of the possible divisors. Remember we prove things so
   we don't care at all if that inefficent
*)
Fixpoint prime_rec p d :=
  match d with
  | 1 => true
  | 0 => true
  | S d =>
    let (q, r) := divn p (S d) in
    if Nat.eqb r 0
    then false
    else prime_rec p d
  end.

(* Spec of the function *)
Lemma prime_rec_spec: forall p d,
  2 <= d ->
  (prime_rec p d = true <-> (forall x, x <= d -> 1 < x -> ~ x `div p)).
Proof.
intro p; induction d as [ | d hi]; intros hd; split; simpl in *.
- now auto with arith.
- intros _; reflexivity.
- apply le_S_n in hd.
  destruct d as [ | d]; [ now auto with arith | ].
  intros h x hle hlt hdiv.
  apply le_lt_eq in hle as [ -> | hle ].
  + apply divn_div in hdiv; unfold divn in hdiv.
    now destruct divn_rec; subst.
  + assert (hd' : 2 <= S d) by
       now destruct d as [ | d];
       [ elim (lt_irrefl 1); apply lt_le_trans with x | auto with arith ].
    apply hi in hd'.
    destruct hd' as [hl hr].
    revert h.
    generalize (divn_rec_spec (S d) p 0).
    destruct divn_rec as [ q r ]; intros [heq [_ hrem]] h.
    rewrite Nat.sub_0_r in heq.
    case_eq (r =? 0); intro h0; rewrite h0 in h; [ discriminate | ].
    now apply hl with x.
- destruct d as [ | d]; [ intros _; reflexivity | ].
  clear hd.
  intro h.
  generalize (divn_rec_spec (S d) p 0).
  destruct divn_rec as [ q r ]; intros [heq [_ hrem]].
  rewrite Nat.sub_0_r in heq.
  case_eq (r =? 0); intro h0.
  + apply Nat.eqb_eq in h0; rewrite h0 in *; clear h0.
    rewrite plus_0_r in heq.
    elim (h (S (S d))).
    * now apply le_refl.
    * now auto with arith.
    * now exists q; rewrite mult_comm.
  + apply Nat.eqb_neq in h0.
    destruct d as [ | d].
    * replace r with 1 in *; [ now idtac | ].
      assert (0 < r) by now destruct r; [elim h0 | auto with arith].
      destruct r as [ | ]; [now elim h0 | ].
      destruct r as [ | ]; [ reflexivity | ].
      apply lt_S_n in hrem.
      apply lt_S_n in hrem.
      now apply lt_n_0 in hrem.
   * apply hi; [now auto with arith | ].
     intros x hle ht hdiv.
     apply h with x; now auto with arith.
Qed.

(* We also need the negative case -> if we are not prime, we get a non trivial
   divisor from the function *)
Lemma prime_rec_spec_false: forall p d,
    prime_rec p d = false -> exists x, x <= d /\ 1 < x /\ x `div p.
Proof.
intro p; induction d as [ | d hi]; intros hp; simpl in *; [ discriminate | ].
destruct d as [ | d]; [ discriminate | ].
generalize (divn_rec_spec (S d) p 0).
revert hp.
destruct divn_rec.
destruct n0 as [ | n0].
- intros _.
  rewrite Nat.sub_0_r, plus_0_r.
  intros [-> _].
  exists (S (S d)); intuition.
  apply divides_lmul.
  now apply divides_refl.
- simpl Nat.eqb; intro h.
  apply hi in h as [q [h0 [h1 h2]]].
  rewrite Nat.sub_0_r; intros [hp [_ hlt]].
  now exists q; intuition.
Qed.

(* Main function *)
Definition primen p :=
    match p with
    | 0 => false
    | 1 => false
    | S q => prime_rec p q
    end.

(* and spec *)
Lemma primen_spec: forall p, primen p = true <-> prime p.
Proof.
unfold primen, prime.
intros [ | p]; split; intro h.
- discriminate h.
- destruct h as [_ h].
  destruct (h 2); [ now apply divides0 | discriminate | discriminate ].
- destruct p as [ | p]; [ discriminate | ].
  split; [ now idtac | ].
  intros x hdiv.
  generalize (prime_rec_spec (S (S p)) (S p)); intro hp.
  destruct p as [ | p].
  + now apply two_is_prime in hdiv.
  + assert (hh: 2 <= S ( S p)) by now auto with arith.
    apply hp in hh as [hl hr].
    case_eq (x =? (S (S (S p)))); intro hx; [ now right; apply Nat.eqb_eq |].
    apply Nat.eqb_neq in hx.
    destruct x as [ | x]; [ destruct hdiv as [q hq]; discriminate | ].
    destruct x as [ | x]; [now left | ].
    right.
    apply hl with (S (S x)) in h.
    * now apply h in hdiv.
    * apply divides_le in hdiv.
      destruct hdiv as [hdiv | ]; [ | discriminate ].
      apply le_lt_eq in hdiv as [ h0 | h1]; [now subst | assumption ].
    * now auto with arith.
- destruct h as [hp hf].
  destruct p as [ | p]; [ now elim hp | ].
  clear hp.
  destruct p as [ | p]; [ reflexivity | ].
  apply prime_rec_spec; [now auto with arith | ].
  intros x hle ht hdiv.
  apply hf in hdiv as [ h | h].
  + subst; now apply lt_irrefl in ht.
  + subst.
    repeat apply le_S_n in hle.
    apply (lt_irrefl (S p)).
    apply le_lt_trans with p; [ assumption | ].
    now constructor.
Qed.

(* every number as at least one prime factor *)
Lemma prime_factor: forall n, n <> 1 -> exists p, prime p /\ p `div n.
Proof.
induction n as [ n hi ] using (well_founded_induction lt_wf).
intros hn1.
case_eq (primen n); intro hp.
- exists n; split.
  + now apply primen_spec.
  + now apply divides_refl.
- unfold primen in hp.
  destruct n as [ | n].
  + now exists 2; split; [ apply two_is_prime | apply divides0 ].
  + destruct n as [ | n]; [ now elim hn1 | ].
    apply prime_rec_spec_false in hp as [q [h0 [h1 h2]]].
    destruct (hi q) as [y [hy0 hy1]].
    * now auto with arith.
    * now intro; subst; apply lt_irrefl in h1.
    * exists y; split;[ assumption | ].
      now apply divides_trans with q.
Qed.

(* for any natural number, there exists a natural number greater than it *)
Lemma euclid: forall n, exists p, n < p /\ prime p.
Proof.
intros n.
apply euclid_.
now apply prime_factor.
Qed.

End NoEM.


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 length(l:natlist):nat:=
match l with
|[ ] = 0
|h::t => 1+ length t
end.*)

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 associative_L3 : forall n o p : natlist, n++(o++p) = (n++o)++p.
Proof.
intros n o p.
induction n.
simpl. reflexivity.
simpl. rewrite -> IHn.
reflexivity.
Qed.

Theorem associative_L4 : forall m n o p : natlist, m++(n++(o++p)) = ((m++n)++o)++p.
Proof.
intros m n o p.
simpl.
induction m as [| x xs].
simpl.
rewrite associative_L3.
reflexivity.
simpl.
rewrite -> IHxs. reflexivity.
Qed.

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

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

Theorem appendEmptyList : forall list : natlist, list ++ [] = list.
Proof.
  intros.

    induction list as [| x xs].
    simpl.
    reflexivity.
    simpl.
    rewrite -> IHxs.
    reflexivity.
Qed.

*)


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

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

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

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


Require Import Arith.

Goal forall n m : nat, (n + m) * (n + m) = n * n + m * m + 2 * n * m.
Proof.
  intros.
  rewrite mult_plus_distr_r.

  assert (2 * n * m = n * m + n * m).
  simpl.
  rewrite plus_assoc.
  rewrite NPeano.Nat.add_0_r.
  rewrite mult_plus_distr_r.
  reflexivity.

  rewrite H.
  rewrite plus_assoc.

  assert ( n * n + m * m + n * m = n * n + n * m + m * m ).
  apply NPeano.Nat.add_shuffle0.
  rewrite H0.

  rewrite <-mult_plus_distr_l.

  assert ( m * (n + m) = m * m + n * m ).
  rewrite plus_comm.
  rewrite mult_comm.
  rewrite mult_plus_distr_r.
  reflexivity.
  rewrite H1.

  rewrite plus_assoc.
  reflexivity.

Qed.

Goal forall n m p q : nat, (n + m) + (p + q) = (n + p) + (m + q).
Proof.
  intros.
  apply plus_permute_2_in_4.
Qed.


Require Import QArith.

Print Q.

Print Qnum.
Print Qden.

Check Qnum.

Definition inj (z :Z):= Qmake z 1.

 Eval compute in (inj 3).

Eval compute in ( (3 # 5) * (4# 6)).

Eval compute in ((2#3)+(4#8)).

Check transitivity.

Check Qlt.
Check Qlt_le_trans.
Check Qlt_le_weak.

Definition interval (p q :Q):={x : Q| p < x /\ x< q}.
Definition interval_empty(p : Q):={x :Q | p < x /\ x< p}.

Lemma ref:forall p q r :Q,p < q /\ q < r -> p < r.
Proof.
intros.
destruct H.
apply (Qlt_le_trans p q r).
apply H.
apply Qlt_le_weak.
apply H0.
Defined.


(** * Indução em Coq *)

Require Export aula04_inducao.
Module NatList.

(* ############################################### *)
(** * Pares de números *)

(** A seguinte declaração pode ser lida como
    "só existe uma maneira de construir um
    par de números, que é aplicando o construtor
    [pair] a dois argumentos do tipo [nat]" *)

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

Check (pair 3 5).

(** Definindo funções para pares.
    Observe o casamento de padrão. *)

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

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

Compute (fst (pair 3 5)).
(* ===> 3 *)

(* Definindo uma notação mais conveniente. *)

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

Compute (fst (3,5)).

(* Observe que é possível, inclusive,
   usar esta sintaxe no casamento de padrões. *)

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

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

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

(** Algumas provas associadas a pares. *)

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

(** Observe que o próximo teorema representa
    o mesmo fato, mas [reflexivity] não
    é suficiente para concluir esta prova. *)

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

(** É preciso expor a estrutura de [p], tal
    que [simpl] possa realizar casamento de
    padrão. [destruct] permite fazer isto. *)

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

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

(* ############################################### *)
(** * Lista de números *)

(** Definição de uma lista de números. *)

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

(** Exemplo de uma lista com 3 elementos. *)

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

(** Definindo uma notação mais conveniente. *)

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

(** As definições a seguir são equivalentes. *)

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

(** Definindo funções para listas. *)

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

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

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

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

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

(** Na definição a seguir, observe o
    valor [default]. *)

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

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

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

(** **** Exercise: (list_funs)  *)
(** Complete as definições de [nonzeros],
    [oddmembers] e [countoddmembers]. Os testes
    mostram o comportamento esperado. *)

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

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

Fixpoint filter (p: nat -> bool)(l: natlist) : natlist :=
  match l with
  | nil => nil
  | h :: t => if p h then h :: filter p t else filter p t
  end.

Fixpoint oddmembers (l:natlist) : natlist := filter oddb l.

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

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

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

Example test_countoddmembers2:
  countoddmembers [0;2;4] = 0.
Proof. reflexivity. Qed.

Example test_countoddmembers3:
  countoddmembers nil = 0.
Proof. reflexivity. Qed.

(* ############################################### *)
(** * Representando multiconjuntos como listas *)

Definition bag := natlist.

(** **** Exercise: (bag_functions)  *)
(** Complete as definições de: [count], [sum],
    [add], e [member] para multiconjuntos (bags).
    Os testes mostram o comportamento esperado. *)

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

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

(** A operação [sum] em multiconjuntos é similar
    ao conceito de [union] de conjuntos: [sum a b]
    contém todos os elementos de [a] e [b].

    Observe que a próxima definição não possui
    nome para os parâmetros, mas somente seus tipos.
    Além disto, a definição não é recursiva. Portanto,
    [sum] precisa ser definida em função de definições
    passadas. *)

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

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

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

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

(** Observe que a próxima definição
    também não é recursiva. *)

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

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

(** **** Exercise: (bag_theorem)  *)
(** Prove o seguinte teorema. Talvez você
    precise provar um teorema auxiliar. *)

Lemma beq_n: forall n: nat,
  beq_nat n n = true.
Proof.
  induction n as [| n' IH].
    - reflexivity.
    - simpl. rewrite IH. reflexivity.
Qed.

Theorem bag_theorem :
  forall (v : nat) (b : bag),
    (count v (add v b)) = (1 + (count v b)).
Proof.
  intros.
  simpl. try reflexivity.
  rewrite beq_n.
  reflexivity.
Qed.

(* ############################################### *)
(** * Raciocinando sobre listas *)

(** Algumas propriedades podem ser provadas
    somente com [reflexivity]. *)

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

(** Às vezes, será preciso fazer análise de casos. *)

Theorem tl_length_pred : forall l:natlist,
  pred (length l) = length (tl l).
Proof.
  (* Observe a quantidade de elementos
     da segunda lista do destruct. *)
  intros l. destruct l as [| n l'].
  - (* l = nil *)
    simpl. reflexivity.
  - (* l = cons n l' *)
    Print length. simpl. reflexivity.
Qed.

(** Às vezes, será preciso fazer indução. *)

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

(** Considere a seguinte definição de [rev]. *)

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

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

(** Vamos tentar provar a seguinte afirmação.
    Observe que ficamos "travados" no segundo caso. *)

Theorem rev_length_firsttry : forall l : natlist,
  length (rev l) = length l.
Proof.
  intros l. induction l as [| n l' IHl'].
  - (* l = [] *)
    reflexivity.
  - (* l = n :: l' *)
    simpl. rewrite <- IHl'.
    (* Como continuar a partir daqui? *)
Abort.

(** Vamos definir um teorema auxiliar a partir
    do ponto em que ficamos "travados" no
    teorema anterior. Contudo, vamos tornar
    o teorema auxiliar o mais geral possível:
    [l1] e [l2] no lugar de [rev l'] e [n]. *)

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

(** Agora concluimos a prova de [rev_length]. *)

Theorem rev_length : forall l : natlist,
  length (rev l) = length l.
Proof.
  intros l. induction l as [| n l' IHl'].
  - (* l = nil *)
    reflexivity.
  - (* l = cons *)
    (* Observe o rewrite  com duas táticas *)
    simpl. rewrite -> app_length, plus_comm.
    simpl. rewrite -> IHl'. reflexivity.
Qed.

(** **** Exercise: (list_exercises)  *)
(** Prove os seguintes teoremas. *)

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

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

Theorem rev_involutive : forall l : natlist,
  rev (rev l) = l.
Proof.
  intros l.
  induction l as [| n l' IH].
  - simpl. reflexivity.
  - simpl. rewrite rev_app_distr. simpl. rewrite IH. reflexivity.
Qed.

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

(** **** Exercise: (beq_natlist)  *)
(** Complete a definição de [beq_natlist], que
    compara listas de números. Veja os exemplos.
    Em seguida, prove o teorema [beq_natlist_refl]. *)

Fixpoint beq_natlist (l1 l2 : natlist) : bool :=
  match l1 with
  | [] =>
    match l2 with
    | [] => true
    | (n2 :: l2') => false
    end
  | (n1 :: l1') =>
    match l2 with
    | [] => false
    | (n2 :: l2') => beq_nat n1 n2 && beq_natlist l1' l2'
    end
  end.

Example test_beq_natlist1 :
  (beq_natlist nil nil = true).
Proof.
  reflexivity.
Qed.

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

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

Theorem beq_natlist_refl : forall l:natlist,
  true = beq_natlist l l.
Proof.
  intros l. induction l as [| n l' IH].
  - reflexivity.
  - simpl. rewrite IH. Search beq_nat.
    rewrite beq_n. simpl. reflexivity.
Qed.

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

(** Considere a seguinte implementação de uma
    função que retorna o i-ésimo elemento
    de uma lista. *)

Fixpoint nth_bad (l:natlist) (n:nat) : nat :=
  match l with
  | nil => 42  (* um valor arbitrário! *)
  | a :: l' => match beq_nat n O with
               | true => a
               | false => nth_bad l' (pred n)
               end
  end.

(** Outra alternativa seria considerar um
    elemento padrão -- ver definição de [hd].

    Uma melhor solução é definir um "option".
    Similar ao conceito de "maybe" em Haskell. *)

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

(** Veja agora a função [nth_error]. *)

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

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

(** A seguir, uma outra possibilidade de
    implementação de [nth_error] usando "if". *)

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

(** No entanto, cuidado com o "if". *)

Inductive tipo : Type :=
  | cons1 : tipo
  | cons2 : tipo.

Definition beq_tipo (n m : nat) : tipo :=
  if beq_nat n m then cons2 else cons1.

Definition teste_if (n m : nat) : bool :=
  if beq_tipo n m then true
  else false.

Compute (teste_if 2 2).

(** O "if" só pode ser aplicado a tipos
    indutivos com dois construtores. *)

(** A função a seguir retira o [nat] encapsulado
    no [natoption]. Observe aqui o uso do default. *)

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

(** **** Exercise: (hd_error)  *)
(** Use a ideia do "option" e atualize
    a definição da função [hd]. *)

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

Example test_hd_error1 : hd_error [] = None.
Proof.
  reflexivity.
Qed.

Example test_hd_error2 : hd_error [1] = Some 1.
Proof.
  reflexivity.
Qed.

Example test_hd_error3 : hd_error [5;6] = Some 5.
Proof.
  reflexivity.
Qed.

(** **** Exercise: (option_elim_hd)  *)
(** Prove o seguinte teorema relacionando
    [hd_error] com [hd]. *)

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

End NatList.

(* ############################################### *)
(** * Mapeamentos parciais *)

(** Veja a seguinte definição de mapeamentos parciais,
    similar aos tipos map ou dictionary das
    principais linguagens de programação.

    Inicialmente, definimos a "chave": o [id]. *)

Inductive id : Type :=
  | Id : nat -> id.

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

(** **** Exercise: (beq_id_refl)  *)
Theorem beq_id_refl :
  forall x, true = beq_id x x.
Proof.
  intros x. destruct x. simpl.
  Search beq_nat. rewrite NatList.beq_n.
  reflexivity.
Qed.

(** Agora, o tipo de mapeamentos parciais *)

Module PartialMap.
Export NatList.

Inductive partial_map : Type :=
  | empty  : partial_map
  | record : id -> nat -> partial_map -> partial_map.

(** Logo, existem duas maneiras de construir
    [partial_map]: usando o construtor [empty],
    representando o mapeamento vazio; usando
    o construtor [record], passando uma chave,
    um número e um mapeamento existente.

    A função [update] atualiza um mapeamento.
    Observe que, conceitualmente, o valor antigo,
    caso exista, é mantido no mapeamento. O
    primeiro valor será o mais recente. *)

Definition update (d : partial_map)
                  (x : id) (value : nat)
                  : partial_map :=
  record x value d.

Example test_partial_map1 :
  (update empty (Id 0) 3)
  = (record (Id 0) 3 empty).
Proof.
    simpl. reflexivity.
Qed.

Example test_partial_map2 :
  (update (record (Id 0) 2 empty) (Id 0) 3)
  = (record (Id 0) 3 (record (Id 0) 2 empty)).
Proof.
    simpl. reflexivity.
Qed.

(** A função [find] procura por um valor em
    um mapeamento. Se houver múltiplos mapeamentos,
    retorna o primeiro. *)

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

(** **** Exercise: (update_eq)  *)
Theorem update_eq :
  forall (d : partial_map) (x : id) (v: nat),
    find x (update d x v) = Some v.
Proof.
  intros d x v. simpl. destruct x.
  - simpl. rewrite NatList.beq_n. reflexivity.
Qed.

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

End PartialMap.

(* ############################################### *)
(** * Leitura sugerida *)

(** Software Foundations: volume 1
  - Lists
  https://softwarefoundations.cis.upenn.edu/lf-current/Lists.html
*)
(* Site legal: https://pjreddie.com/coq-tactics/*)