Require Export Basic.

Theorem n_plus_O: forall n:nat,
  n = n + O.
Proof.
  intros.
  induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite <- IHn'. reflexivity.
Qed.

Theorem minus_diag: forall n:nat,
  n - n = O.
Proof.
  intros.
  induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite -> IHn'. reflexivity.
Qed.

Theorem mult_O_r: forall n:nat,
  n * O = O.
Proof.
  intros.
  induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite -> IHn'. reflexivity.
Qed.

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

Theorem plus_comm: forall (n m:nat),
  n + m = m + n.
Proof.
  intros.
  induction n as [| n' IHn'].
  - simpl. rewrite <- plus_O_r. reflexivity.
  - induction m as [| m' IHm'].
    + simpl. rewrite <- plus_O_r. reflexivity.
    + simpl. rewrite -> IHn'. simpl. rewrite -> plus_n_Sm. reflexivity.
Qed.

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

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

Lemma double_plus: forall n:nat, double n = n + n.
Proof.
  intros.
  induction n as [| n' IHn'].
  - simpl. reflexivity.
  - simpl. rewrite -> IHn'. rewrite -> plus_n_Sm. reflexivity.
Qed.

Theorem evenb_S: forall n: nat,
  evenb (S n) = negb (evenb n).
Proof.
  intros.
  induction n as [| n' IHn'].
  - simpl. reflexivity.
  - rewrite -> IHn'. simpl. rewrite -> negb_involutive. reflexivity.
Qed.

Theorem mult_O_plus: forall n m:nat,
  (O + n) * m = n * m.
Proof.
  intros.
  assert (H: O + n = n). { reflexivity. }
  rewrite -> H.
  reflexivity.
Qed.

Theorem plus_rearrange : forall n m p q:nat,
  (n + m) + (p + q) = (m + n) + (p + q).
Proof.
  intros.
  assert (H: n + m = m + n). { rewrite -> plus_comm. reflexivity. }
  rewrite -> H.
  reflexivity.
Qed.

Theorem plus_swap : forall n m p:nat,
  n + (m + p) = m + (n + p).
Proof.
  intros.
  rewrite <- plus_assoc.
  assert (H: m + (n + p) = (m + n) + p). { rewrite -> plus_assoc. reflexivity. }
  rewrite -> H.
  rewrite <- plus_comm.
  assert (I: m + n + p = p + (m + n)). { rewrite -> plus_comm. reflexivity. }
  rewrite -> I.
  assert (J: n + m = m + n). { rewrite -> plus_comm. reflexivity. }
  rewrite -> J.
  reflexivity.
Qed.

Theorem mult_a_Sb: forall a b:nat,
  a * S b = a + a * b.
Proof.
  intros.
  induction a as [| a' IHa'].
  - simpl.
    reflexivity.
  - simpl.
    rewrite -> IHa'.
    rewrite -> plus_swap.
    reflexivity.
Qed.

Theorem mult_comm: forall n m:nat,
  m * n = n * m.
Proof.
  intros.
  induction n as [| n' IHn'].
  - rewrite -> mult_O_l. rewrite -> mult_O_r. reflexivity.
  - simpl. rewrite <- IHn'. induction m as [| m' IHm'].
    + simpl. reflexivity.
    + simpl.
      rewrite -> mult_a_Sb.
      rewrite -> plus_swap.
      reflexivity.
Qed.

(* exercises *)
Theorem leb_refl : forall n:nat,
  true = leb n n.
Proof.
  intros.
  induction n as [| n' IHn'].
  - reflexivity.
  - rewrite -> IHn'. reflexivity.
Qed.

Theorem zero_nbeq_S : forall n:nat,
  beq_nat 0 (S n) = false.
Proof.
  intros.
  destruct n as [| n'].
  - reflexivity.
  - reflexivity.
Qed.

Theorem andb_false_r : forall b : bool,
  andb b false = false.
Proof.
  intros.
  destruct b as [| b'].
  - reflexivity.
  - reflexivity.
Qed.

Theorem plus_ble_compat_l : forall n m p : nat,
  leb n m = true -> leb (p + n) (p + m) = true.
Proof.
  intros.
  induction p as [| p' IHp'].
  - simpl. rewrite -> H. reflexivity.
  - simpl. rewrite -> IHp'. reflexivity.
Qed.

Theorem S_nbeq_0 : forall n:nat,
  beq_nat (S n) 0 = false.
Proof.
  intros.
  replace (S n) with (n + 1).
  - rewrite -> plus_1_neq_0. reflexivity.
  - rewrite <- plus_1_r. reflexivity.
Qed.

Theorem mult_1_l : forall n:nat, 1 * n = n.
Proof.
  intros.
  destruct n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite <- plus_O_r. reflexivity.
Qed.

Theorem all3_spec : forall b c : bool,
    orb
      (andb b c)
      (orb (negb b)
               (negb c))
  = true.
Proof.
  intros.
  destruct b as [| b'].
  destruct c as [| c'].
  - reflexivity.
  - reflexivity.
  - reflexivity.
Qed.

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

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

Theorem beq_nat_refl : forall n : nat,
  true = beq_nat n n.
Proof.
  intros.
  induction n as [| n' IHn'].
  - simpl. reflexivity.
  - simpl. rewrite -> IHn'. reflexivity.
Qed.

Theorem plus_swap' : forall n m p:nat,
  n + (m + p) = m + (n + p).
Proof.
  intros.
  intros.
  rewrite <- plus_assoc.
  assert (H: m + (n + p) = (m + n) + p). { rewrite -> plus_assoc. reflexivity. }
  rewrite -> H.
  rewrite <- plus_comm.
  replace (m + n + p) with (p + (m + n)).
  - replace (n + m) with (m + n).
    + reflexivity.
    + rewrite -> plus_comm. reflexivity.
  - rewrite -> plus_comm. reflexivity.
Qed.

Theorem bin_to_nat_pres_incr: forall b:bin,
  (bin_to_nat (incr b)) = S (bin_to_nat b).
Proof.
  intros.
  induction b as [| b' | b'' IHb'].
  - simpl. reflexivity.
  - simpl. rewrite -> IHb'. simpl.
    replace (bin_to_nat b' + 0) with (bin_to_nat b').
    + rewrite <- plus_1_r. rewrite <- plus_n_Sm. reflexivity.
    + rewrite <- plus_O_r. reflexivity.
  - simpl. rewrite <- plus_1_r. reflexivity.
Qed.

(* binary inverse *)
Fixpoint nat_to_bin (n: nat) : bin :=
  match n with
  | O => Zero
  | S n' => incr (nat_to_bin n')
  end.

Theorem nat_bin_nat: forall (n: nat),
  bin_to_nat (nat_to_bin n) = n.
Proof.
  intros.
  induction n as [| n' IH].
  - reflexivity.
  - simpl.
    rewrite -> bin_to_nat_pres_incr.
    rewrite -> IH.
    reflexivity.
Qed.

Fixpoint normalize (b: bin) : bin :=
  match b with
  | Zero => Zero
  | Twice b' => match (normalize b') with
                | Zero => Zero
                | _ => Twice (normalize b')
                end
  | TwicePlusOne b' => TwicePlusOne (normalize b')
  end.

Compute (normalize (TwicePlusOne (Twice (TwicePlusOne (Twice (TwicePlusOne (Twice Zero))))))).

Compute (normalize (normalize (Twice Zero))).

Theorem nat_twice_plus_one: forall (n:nat),
    nat_to_bin (n + n + 1) = TwicePlusOne (nat_to_bin n).
Proof.
  intros.
  induction n as [| n' IH].
  - reflexivity.
  - simpl.
    replace (n' + S n') with (S (n' + n')).
    + simpl.
      rewrite -> IH.
      reflexivity.
    + rewrite -> plus_n_Sm.
      reflexivity.
Qed.

Theorem normalize_incr: forall (b: bin),
  incr (normalize b) = normalize (incr b).
Proof.
  intros.
  induction b as [| b' | b'' IH].
  - reflexivity.
  - simpl.
    rewrite <- IHb'.
    destruct (normalize b').
    + reflexivity.
    + reflexivity.
    + reflexivity.
  - simpl.
    destruct (normalize b'').
    + reflexivity.
    + reflexivity.
    + reflexivity.
Qed.

Theorem nat_twice: forall (n: nat),
    nat_to_bin (n + n) = normalize (Twice (nat_to_bin n)).
Proof.
  intros.
  induction n as [| n' IH].
  - reflexivity.
  - rewrite <- plus_n_Sm.
    simpl.
    rewrite <- normalize_incr.
    rewrite -> IH.
    induction (nat_to_bin n') as [| b | b' IHb].
    + reflexivity.
    + reflexivity.
    + rewrite <- IH.
Admitted.

Theorem normalize_idemp: forall (b: bin),
  normalize (normalize b) = normalize b.
Proof.
  intros.
  induction b as [| b' | b'' IH].
  - reflexivity.
  - simpl.
    rewrite -> IHb'.
    reflexivity.
  - induction (normalize (Twice b'')).
    + reflexivity.
    + simpl.
      rewrite -> IHb.
      reflexivity.
    +
      rewrite -> IHb.
      simpl.

  - induction b'' as [| c | c' IH'].
    + reflexivity.
    + simpl.
      simpl in IH.
      rewrite -> IH.
      reflexivity.
Admitted.

Theorem bin_nat_bin: forall (b: bin),
  nat_to_bin (bin_to_nat b) = normalize b.
Proof.
  intros.
  induction b as [| b' | b'' IH].
  - reflexivity.
  - simpl.
    rewrite <- plus_O_r.
    rewrite -> nat_twice_plus_one.
    rewrite -> IHb'.
    reflexivity.
  - simpl.
    rewrite <- plus_O_r.
    rewrite -> nat_twice.
    simpl.
    rewrite -> IH.
    rewrite -> normalize_idemp.
    reflexivity.
Qed.


Require Import Arith.
From QuickChick Require Import QuickChick.
Inductive natural : Type := Succ : natural -> natural |  Zero : natural.
Derive Show for natural. Derive Arbitrary for natural.  Instance Dec_Eq_natural : Dec_Eq natural. Proof. dec_eq. Qed.
Inductive lst : Type := Cons : natural -> lst -> lst |  Nil : lst.

Inductive tree : Type := Node : natural -> tree -> tree -> tree |  Leaf : tree.

Inductive Pair : Type := mkpair : natural -> natural -> Pair
with Zlst : Type := zcons : Pair -> Zlst -> Zlst |  znil : Zlst.

Fixpoint eqb (n m: natural) : bool :=
  match n, m with
    | Zero, Zero => true
    | Zero, Succ _ => false
    | Succ _, Zero => false
    | Succ n', Succ m' => eqb n' m'
  end.

  Fixpoint mem  (mem_arg1 : lst) (mem_arg0 : natural)
  := match mem_arg0, mem_arg1 with
    | x, Nil => false
    | x, Cons y z => orb (eqb x y) (mem z x)
    end.

Fixpoint less (less_arg0 : natural) (less_arg1 : natural) : bool
           := match less_arg0, less_arg1 with
              | x, Zero => false
              | Zero, Succ x => true
              | Succ x, Succ y => less x y
              end.

Fixpoint insort  (insort_arg1 : lst) (insort_arg0 : natural) : lst
           := match insort_arg1, insort_arg0 with
              |  Nil, i => Cons i Nil
              | Cons x y, i => if less i x then Cons i (Cons x y) else Cons x (insort y i)
              end.

Fixpoint sort (sort_arg0 : lst) : lst
           := match sort_arg0 with
              | Nil => Nil
              | Cons x y => insort (sort y) x
              end.

Fixpoint len (len_arg0 : lst) : natural
:= match len_arg0 with
   | Nil => Zero
   | Cons x y => Succ (len y)
   end.

Theorem insort_len: forall (n: natural) (x : lst), len (insort x n) = Succ (len x).
   intro.
   induction x.
   { simpl. destruct (less n n0).
      {
      simpl. reflexivity.
      }
      {
      simpl. rewrite IHx.
      reflexivity.
      }
   }
   {
      simpl. reflexivity.
   }
Qed.

Theorem theorem0 : forall (x : lst), eq (len (sort x)) (len x).
Proof.
   induction x; simpl; try reflexivity.
   rewrite insort_len.
   f_equal; assumption.
Qed.


Require Import Reals.
Require Import Lra.
Require Import Omega.
Local Open Scope R_scope.

Definition three_x (x : R) := 3 * x.

Definition neighborhood (eps : R) (point : R) :=
  fun x => point - eps < x < point + eps.

Definition continuous_c (f : R -> R) (c : R) :=
  forall (eps : R), exists (delt : R),
      eps > 0 -> delt > 0 ->
      forall x, neighborhood delt c x -> neighborhood eps (f c) (f x).

Theorem three_x_continuous_at_0 : continuous_c three_x 0.
Proof.
  unfold continuous_c.
  intros. exists (eps / 3). intros.
  unfold neighborhood.
  split; unfold three_x; unfold neighborhood in H1; lra.
Qed.

Definition continuous (f : R -> R) :=
  forall (c : R), continuous_c f c.

Theorem three_x_continuous : continuous three_x.
  unfold continuous.
  intros; unfold continuous_c; intros.
  exists (eps / 3).
  intros; unfold neighborhood; unfold three_x.
  unfold neighborhood in H1.
  lra.
Qed.

Definition uniformly_continuous' (f : R -> R) :=
  forall (eps : R), exists (delt : R),
      eps > 0 -> delt > 0 ->
      forall (x y : R), Rabs (x - y) < delt -> Rabs (f x - f y) < eps.

Definition uniformly_continuous (f : R -> R) :=
  forall (eps : R), exists (delt : R),
      eps > 0 -> delt > 0 ->
      forall (x y : R), neighborhood delt x y -> neighborhood eps (f x) (f y).

Theorem three_x_uniformly_continuous : uniformly_continuous three_x.
Proof.
  unfold uniformly_continuous.
  intros eps.
  exists (eps / 3).
  intros H1 H2 x y G1.
  unfold neighborhood. unfold neighborhood in G1.
  unfold three_x.
  lra.
Qed.

Check neighborhood 1 1.

(*compactness*)
Definition closed_unit_interval (x : R) := 0 <= x <= 1.

Definition limit_point (A : R -> Prop) (x : R) :=
  forall eps, exists x', eps > 0 /\ neighborhood eps x x' /\ A x' /\ x <> x'.

Definition closed' (A : R -> Prop) :=
  forall x, limit_point A x -> A x.

Definition complement (A : R -> Prop) :=
  fun (x : R) => ~ (A x).

Definition open (A : R -> Prop) :=
  forall x, A x -> exists eps, eps > 0 /\ (forall x', neighborhood eps x x' -> A x').

Definition closed (A : R -> Prop) :=
  open A -> forall x, complement A x.

Theorem closed_unit_interval_is_closed : closed closed_unit_interval.
Proof.
  unfold closed.
  intros H x.
  unfold complement; unfold not; intro G.
  unfold open in H.
  assert (E : closed_unit_interval 1). { unfold closed_unit_interval; lra. }
  destruct (H 1 E) as [eps1 H'].
  destruct H' as [H1' H2'].
  unfold neighborhood in H2'.
  destruct (H2' (1 + eps1 / 2)).
  - lra.
  - lra.
Qed.

Definition is_upper_bound (A : R -> Prop) (b : R) := forall x, A x -> x <= b.

Definition is_lower_bound (A : R -> Prop) (b : R) := forall x, A x -> x >= b.

Definition bounded (A : R -> Prop) := (exists m, is_upper_bound A m) /\ (exists b, is_lower_bound A b).

Ltac show_boundedness b is_bound A :=
  exists b; unfold is_bound; intros x H; unfold A in H; lra.

Theorem closed_unit_interval_is_bounded : bounded closed_unit_interval.
Proof.
  unfold bounded.
  split.
  - show_boundedness 2 is_upper_bound closed_unit_interval.
  - show_boundedness (0-1) is_lower_bound closed_unit_interval.
Qed.

Definition compact (A : R -> Prop) := closed A /\ bounded A.

Theorem closed_unit_interval_is_compact : compact closed_unit_interval.
Proof.
  unfold compact.
  split.
  - apply closed_unit_interval_is_closed.
  - apply closed_unit_interval_is_bounded.
Qed.

(**Preservation of compactness*)

Definition empty (x : R) := x < 5 /\ x > 6.

Definition image' (f : R -> R) (A : R -> Prop) (B : R -> Prop) := forall x, A x -> B (f x).
(*I really want image to land in R -> Prop *)

Check image' three_x closed_unit_interval.

Theorem image'_test1 : image' three_x closed_unit_interval (fun x => 0 <= x <= 3).
Proof.
  unfold image'.
  intros x H.
  unfold three_x.
  unfold closed_unit_interval in H.
  lra.
Qed.

Theorem image'_test2 : image' three_x empty empty.
Proof.
  unfold image'.
  intros x H.
  unfold three_x.
  unfold empty in H.
  unfold empty.
  lra.
Qed.
(*Now that i have image as a relation between two sets, i want image as a function R -> Prop *)


Section NaturalNumbers.

Inductive peano : Set :=
    | Z : peano
    | S : peano -> peano.

(* Def 1.2 *)
Inductive Plus : peano -> peano -> peano -> Prop :=
    | P_Zero : forall n : peano, Plus Z n n
    | P_Succ : forall n1 n2 n3 : peano,
               Plus n1 n2 n3 -> Plus (S n1) n2 (S n3).

(* Def 1.3 *)
Inductive Times : peano -> peano -> peano -> Prop :=
    | T_Zero : forall n : peano, Times Z n Z
    | T_Succ : forall n1 n2 n3 n4 : peano,
               Times n1 n2 n3 -> Plus n2 n3 n4 -> Times (S n1) n2 n4.

(* Fig 1.3 *)
Inductive LessThan1 : peano -> peano -> Prop :=
    | L1_Succ  : forall n : peano, LessThan1 n (S n)
    | L1_Trans : forall n1 n2 n3 : peano,
                 LessThan1 n1 n2 -> LessThan1 n2 n3 -> LessThan1 n1 n3.

(* Fig 1.4 *)
Inductive LessThan2 : peano -> peano -> Prop :=
    | L2_Zero     : forall n : peano, LessThan2 Z (S n)
    | L2_SuccSucc : forall n1 n2 : peano,
                    LessThan2 n1 n2 -> LessThan2 (S n1) (S n2).

(* Fig 1.5 *)
Inductive LessThan3 : peano -> peano -> Prop :=
    | L3_Succ  : forall n : peano, LessThan3 n (S n)
    | L3_SuccR : forall n1 n2 : peano, LessThan3 n1 n2 -> LessThan3 n1 (S n2).

(* Def 1.5 *)
Inductive Exp : Set :=
    | ENum   : peano -> Exp
    | EPlus  : Exp -> Exp -> Exp
    | ETimes : Exp -> Exp -> Exp.

(* Fig 1.7 *)
Inductive EvalTo : Exp -> peano -> Prop :=
    | E_Const : forall n : peano, EvalTo (ENum n) n
    | E_Plus  : forall (e1 e2 : Exp) (n1 n2 n : peano),
                EvalTo e1 n1 -> EvalTo e2 n2 -> Plus n1 n2 n ->
                EvalTo (EPlus e1 e2) n
    | E_Times : forall (e1 e2 : Exp) (n1 n2 n : peano),
                EvalTo e1 n1 -> EvalTo e2 n2 -> Times n1 n2 n ->
                EvalTo (ETimes e1 e2) n.

(* Fig 1.8 *)
Inductive ReduceTo : Exp -> Exp -> Prop :=
    | R_Plus   : forall n1 n2 n3 : peano,
                 Plus n1 n2 n3 -> ReduceTo (EPlus (ENum n1) (ENum n2)) (ENum n3)
    | R_Times  : forall n1 n2 n3 : peano,
                 Times n1 n2 n3 ->
                 ReduceTo (ETimes (ENum n1) (ENum n2)) (ENum n3)
    | R_PlusL  : forall e1 e1' e2 : Exp,
                 ReduceTo e1 e1' -> ReduceTo (EPlus e1 e2) (EPlus e1' e2)
    | R_PlusR  : forall e1 e2 e2' : Exp,
                 ReduceTo e2 e2' -> ReduceTo (EPlus e1 e2) (EPlus e1 e2')
    | R_TimesL : forall e1 e1' e2 : Exp,
                 ReduceTo e1 e1' -> ReduceTo (ETimes e1 e2) (ETimes e1' e2)
    | R_TimesR : forall e1 e2 e2' : Exp,
                 ReduceTo e2 e2' -> ReduceTo (ETimes e1 e2) (ETimes e1 e2').

(* Fig 1.9 *)
Inductive MultiReduceTo : Exp -> Exp -> Prop :=
    | MR_Zero  : forall e : Exp, MultiReduceTo e e
    | MR_One   : forall e e' : Exp, ReduceTo e e' -> MultiReduceTo e e'
    | MR_Multi : forall e e' e'' : Exp,
                 MultiReduceTo e e' -> MultiReduceTo e' e'' ->
                 MultiReduceTo e e''.

(* Fig 1.10 *)
Inductive DetReduceTo : Exp -> Exp -> Prop :=
    | DR_Plus   : forall n1 n2 n3 : peano,
                  Plus n1 n2 n3 ->
                  DetReduceTo (EPlus (ENum n1) (ENum n2)) (ENum n3)
    | DR_Times  : forall n1 n2 n3 : peano,
                  Times n1 n2 n3 ->
                  DetReduceTo (ETimes (ENum n1) (ENum n2)) (ENum n3)
    | DR_PlusL  : forall e1 e1' e2 : Exp,
                  DetReduceTo e1 e1' ->
                  DetReduceTo (EPlus e1 e2) (EPlus e1' e2)
    | DR_PlusR  : forall (n1 : peano) (e2 e2' : Exp),
                  DetReduceTo e2 e2' ->
                  DetReduceTo (EPlus (ENum n1) e2) (EPlus (ENum n1) e2')
    | DR_TimesL : forall e1 e1' e2 : Exp,
                  DetReduceTo e1 e1' ->
                  DetReduceTo (ETimes e1 e2) (ETimes e1' e2)
    | DR_TimesR : forall (n1 : peano) (e2 e2' : Exp),
                  DetReduceTo e2 e2' ->
                  DetReduceTo (ETimes (ENum n1) e2) (ETimes (ENum n1) e2').

End NaturalNumbers.


(*Practica 4*)

Section Ejercicio1.

(*Ejercicio 1*)
(* 1.1 *)
Inductive list (A:Set) : Set :=
                nil : list A
              | cons : A -> list A -> list A.

Inductive bintree (A:Set) : Set :=
                nilB : bintree A
              | consB : A -> bintree A -> bintree A -> bintree A.

(* 1.2 *)
Inductive Array (A:Set) : nat -> Set :=
                nilA : Array A 0
              | consA : forall n:nat, A -> Array A n -> Array A (n+1).

Inductive Matrix (A:Set) : nat -> nat -> Set :=
   oneF : forall n:nat, Array A (n+1) -> Matrix A 1 (n+1)
 | consMf : forall (m n:nat), Array A n -> Matrix A m n -> Matrix A (m+1) n.

(* 1.3 *)
Inductive leq : nat -> nat -> Prop :=
   leqI : forall n:nat, leq n n
 | leqS : forall (m n:nat), leq m n -> leq m (S n).

(* 1.4 *)
Inductive eq_list (A:Set) (P:A->A->Prop) : list A -> list A -> Prop :=
   eqEmpty : eq_list A P (nil A) (nil A)
 | eqOther : forall (xs ys:list A) (x y: A), P x y -> eq_list A P xs ys
                        -> eq_list A P (cons A x xs) (cons A y ys).

(* 1.5 *)
Inductive sorted (A:Set) (R:A->A->Prop) : list A -> Prop :=
   sortEmpty : sorted A R (nil A)
 | sortOne : forall x:A, sorted A R (cons A x (nil A))
 | sortMore : forall (xs: list A) (x y:A), R x y -> sorted A R xs
                       -> sorted A R (cons A x (cons A y xs)).

(* 1.6 *)
Inductive mirror (A:Set) : bintree A -> bintree A -> Prop :=
   mirrNil : mirror A (nilB A) (nilB A)
 | mirrCons : forall (t1 t2 t3 t4 : bintree A) (x y : A),
                    mirror A t1 t4 -> mirror A t2 t3
                       -> mirror A (consB A x t1 t2) (consB A y t3 t4).

(* 1.7 *)
Inductive isomorfo (A B:Set) : bintree A -> bintree B -> Prop :=
   isoNil : isomorfo A B (nilB A) (nilB B)
 | isoCons : forall (t1 t2 : bintree A) (t3 t4 : bintree B) (x : A) (y : B),
                  isomorfo A B t1 t3 -> isomorfo A B t2 t4
                       -> isomorfo A B (consB A x t1 t2) (consB B y t3 t4).

(* 1.8 *)
Inductive Gtree (A B:Set) : Set :=
     node: A -> Gforest A B -> Gtree A B
   | hoja: B -> Gtree A B
with
  Gforest (A B:Set) : Set :=
             oneTree : Gtree A B -> Gforest A B
           | add_tree: Gtree A B -> Gforest A B -> Gforest A B.

End Ejercicio1.

Section Ejercicio2.

(* 2.1 *)
Fixpoint Or (a b: bool) : bool := match a with
                                        true => true
                                      | false => b
                                  end.

Fixpoint And (a b: bool) : bool := match a with
                                         true => b
                                       | false => false
                                   end.

Fixpoint Not (a: bool) : bool := match a with
                                       true => false
                                     | _ => true
                                 end.

Fixpoint Xor (a b: bool) : bool := match a with
                                         false => b
                                       | true => Not b
                                   end.

(* 2.2 *)

Fixpoint is_nil (A:Set) (xs : list A) : bool :=
  match xs with
        nil => true
      | cons y ys => false
  end.

End Ejercicio2.

Section Ejercicio3.

Fixpoint Sum (a b :nat) {struct b} :nat :=
  match b with
        0   => a
      | S k => S (Sum a k)
  end.

Fixpoint Prod (a b :nat) : nat :=
  match a with
        0   => 0
      | S k => (Sum (Prod k b) b)
  end.

Fixpoint Pot (a b: nat) : nat :=
  match b with
        0   => 1
      | S k => Prod a (Pot a k)
  end.

Fixpoint leBool (a b : nat) : bool :=
  match a, b with
        0, _     => true
      | S k, 0   => false
      | S k, S j => leBool k j
  end.

End Ejercicio3.

Section Ejercicio4.

Fixpoint length (A:Set) (xs : list A) : nat :=
  match xs with
        nil => 0
      | cons y ys => S (length A ys)
  end.

Fixpoint append (A:Set) (xs ys : list A) : list A :=
  match xs with
        nil => ys
      | cons z zs => cons A z (append A zs ys)
  end.

Fixpoint reverse (A:Set) (xs : list A) : list A :=
  match xs with
        nil => nil A
      | cons z zs => append A (reverse A zs) (cons A z (nil A))
  end.

Fixpoint filter (A:Set) (f : A -> bool) (xs : list A) : list A :=
  match xs with
        nil => nil A
      | cons z zs => match f z with
                           true => cons A z (filter A f zs)
                         | _    => filter A f zs
                     end
  end.

Fixpoint map (A B:Set) (f : A -> B) (xs : list A) : list B :=
  match xs with
        nil => nil B
      | cons z zs => cons B (f z) (map A B f zs)
  end.

Fixpoint exists_ (A:Set) (f : A -> bool) (xs : list A) : bool :=
  match xs with
        nil => false
      | cons z zs => match f z with
                           true  => true
                         | false => exists_ A f zs
                     end
  end.

End Ejercicio4.

Section Ejercicio5.

(* 5.1 *)
Fixpoint inverse (A:Set) (t : bintree A) : bintree A :=
  match t with
        nilB => nilB A
      | consB x t1 t2 => consB A x (inverse A t2) (inverse A t1)
  end.

(* 5.2 *)
(* Funciones auxiliares *)
Fixpoint nodosInternosT (A B:Set) (t: Gtree A B) : nat :=
  match t with
        hoja x    => 0
      | node x ft => S (nodosInternosF A B ft)
  end
with
  nodosInternosF (A B:Set) (f: Gforest A B) : nat :=
    match f with
          oneTree t     => nodosInternosT A B t
        | add_tree t ft => (nodosInternosT A B t) + (nodosInternosF A B ft)
    end.

Fixpoint nodosExternosT (A B:Set) (t: Gtree A B) : nat :=
  match t with
        hoja x    => 1
      | node x ft => nodosExternosF A B ft
  end
with
  nodosExternosF (A B:Set) (f: Gforest A B) : nat :=
    match f with
          oneTree t     => nodosExternosT A B t
        | add_tree t ft => (nodosExternosT A B t) + (nodosExternosF A B ft)
    end.

(* Función pedida *)
Fixpoint moreInternal (A B:Set) (t : Gtree A B) : bool :=
  leBool (nodosExternosT A B t) (nodosInternosT A B t).

End Ejercicio5.

Section Ejercicio6.

Definition ListN : Set := list nat.

(*Función auxiliar*)
Fixpoint is_equal (x y:nat) : bool :=
  match x, y with
        0, 0 => true
      | 0, _ => false
      | _, 0 => false
      | S a, S b => is_equal a b
  end.

(*6.1*)
Fixpoint member (n:nat) (xs : ListN) : bool :=
  exists_ nat (is_equal n) xs.

(*6.2*)
Fixpoint delete (ls : ListN) (n : nat) : ListN :=
  match ls with
        nil => nil nat
      | cons x xs => match is_equal n x with
                           true  => delete xs n
                         | false => cons nat x (delete xs n)
                     end
  end.

(*6.3*)
Fixpoint insert (n:nat) (ls : ListN) : ListN :=
  match ls with
        nil => cons nat n (nil nat)
      | cons x xs => match leBool n x with
                           true  => cons nat n (cons nat x xs)
                         | false => cons nat x (insert n xs)
                     end
  end.

Fixpoint insert_sort (ls : ListN) : ListN :=
  match ls with
        nil => nil nat
      | cons x xs => insert x (insert_sort xs)
  end.

End Ejercicio6.

Section Ejercicio7.

Inductive Exp (A: Set) : Set :=
              atom     : A -> Exp A
            | SumExp   : Exp A -> Exp A -> Exp A
            | ProdExp  : Exp A -> Exp A -> Exp A
            | NegExp   : Exp A -> Exp A.

Fixpoint EvalExpNat (e : Exp nat) : nat :=
  match e with
        atom n        => n
      | SumExp e1 e2  => (EvalExpNat e1) + (EvalExpNat e2)
      | ProdExp e1 e2 => (EvalExpNat e1) * (EvalExpNat e2)
      | NegExp e1     => 0 - (EvalExpNat e1)
  end.

Fixpoint EvalExpBool (e : Exp bool) : bool :=
  match e with
        atom b        => b
      | SumExp e1 e2  => Or (EvalExpBool e1) (EvalExpBool e2)
      | ProdExp e1 e2 => And (EvalExpBool e1) (EvalExpBool e2)
      | NegExp e1     => Not (EvalExpBool e1)
  end.

End Ejercicio7.

Section Ejercicio8.

Lemma AsocAnd : forall a b c: bool, And (And a b) c = And a (And b c).
Proof.
  intros.
  case a, b, c; trivial.
Qed.

Lemma AsocOr : forall a b c: bool, Or (Or a b) c = Or a (Or b c).
Proof.
  case a, b, c; trivial.
Qed.

Lemma ConmutAnd : forall a b: bool, And a b = And b a.
Proof.
  case a, b; trivial.
Qed.

Lemma ConmutOr : forall a b: bool, Or a b = Or b a.
Proof.
  case a, b; trivial.
Qed.

Lemma LAnd : forall a b : bool, And a b = true <-> a = true /\ b = true.
Proof.
  unfold iff.
  split; intro.
  split;trivial.
  induction a; trivial.
  induction b; trivial.
  elim H.
  case a; trivial.
  elim H; intros.
  rewrite -> H0.
  rewrite -> H1.
  trivial.
Qed.

Lemma LOr1 : forall a b : bool, Or a b = false <-> a = false /\ b = false.
Proof.
  unfold iff.
  split; intro.
  split.
  destruct a; trivial.
  destruct a.
  discriminate.
  trivial.
  elim H; intros.
  rewrite -> H0.
  rewrite -> H1.
  trivial.
Qed.

Lemma LOr2 : forall a b : bool, Or a b = true <-> a = true \/ b = true.
Proof.
  unfold iff.
  split; intro.
  destruct a, b.
  left; trivial.
  left; trivial.
  right; trivial.
  right; trivial.
  elim H; intro; rewrite -> H0.
  trivial.
  case a; trivial.
Qed.

Lemma LXor : forall a b : bool, Xor a b = true <-> a <> b.
Proof.
  unfold iff.
  split; unfold not; intros; destruct a; simpl.
  rewrite <- H0 in H; discriminate.
  rewrite <- H0 in H; discriminate.
  destruct b; simpl; [elim H|]; trivial.
  destruct b.
  trivial.
  elim H; trivial.
Qed.

Lemma LNot : forall b : bool, Not (Not b) = b.
Proof.
  destruct b; trivial.
Qed.

End Ejercicio8.

(*----------------------SE ENTREGA------------------------*)
(*Requiere Ej3 (Prod, Sum) *)
Section Ejercicio9.

(* 9.1 *)
Lemma SumO : forall n : nat, Sum n 0 = n.
Proof.
  constructor.
Qed.

(* 9.2 *)
Lemma SumS : forall n m : nat, Sum n (S m) = Sum (S n) m.
Proof.
  induction m; simpl.
  constructor.
  rewrite <- IHm.
  simpl.
  trivial.
Qed.

(* 9.3 *)
Lemma SumConm : forall n m : nat, Sum n m = Sum m n.
Proof.
  induction m; simpl.
  induction n; trivial.
  simpl.
  elim IHn.
  trivial.
  elim (SumS m n).
  simpl.
  elim IHm.
  trivial.
Qed.

(* 9.4 *)
Lemma SumAsoc : forall n m p : nat, Sum n (Sum m p) = Sum (Sum n m) p.
Proof.
  induction p; simpl.
  trivial.
  rewrite -> IHp.
  trivial.
Qed.

(* Lema Auxiliar *)
Lemma ProdS : forall n m : nat, Prod n (S m) = Sum (Prod n m) n.
Proof.
  intros.
  induction n; simpl.
  trivial.
  rewrite -> IHn.
  elim SumConm.
  apply f_equal.
  rewrite -> SumAsoc.
  replace (Sum m (Prod n m)) with (Sum (Prod n m) m).
  trivial.
  elim SumConm.
  trivial.
Qed.

(* 9.5 *)
Lemma ProdConm : forall n m : nat, Prod n m = Prod m n.
Proof.
  induction m; simpl.
  induction n; simpl.
  trivial.
  rewrite -> IHn.
  trivial.
  rewrite <- IHm.
  apply (ProdS n m).
Qed.

(* 9.7 *)
Lemma ProdDistr : forall n m p : nat, Prod n (Sum m p) = Sum (Prod n m) (Prod n p).
Proof.
  induction n; simpl.
  trivial.
  intros.
  rewrite -> IHn.
  rewrite -> SumAsoc.
  symmetry.
  rewrite -> SumAsoc.
  pattern (Sum (Sum (Prod n m) m) (Prod n p)).
  elim SumAsoc.
  pattern (Sum m (Prod n p)).
  elim SumConm.
  rewrite -> SumAsoc.
  trivial.
Qed.

(* 9.6 *)
Lemma ProdAsoc : forall n m p : nat, Prod n (Prod m p) = Prod (Prod n m) p.
Proof.
  intros.
  induction n; simpl.
  trivial.
  rewrite -> IHn.
  symmetry.
  elim ProdConm.
  rewrite -> (ProdDistr p (Prod n m) m).
  elim ProdConm.
  rewrite -> (ProdConm p m).
  trivial.
Qed.

End Ejercicio9.
(*--------------------------------------------------------*)

(*----------------------SE ENTREGA------------------------*)
Section Ejercicio10.
(* 10.1 *)
(*
Fixpoint append (A:Set) (xs ys : list A) : list A :=
  match xs with
        nil => ys
      | cons z zs => cons A z (append A zs ys)
  end.
*)

Lemma L1 : forall (A : Set) (l : list A), append A l (nil A) = l.
Proof.
  intros.
  induction l.
  trivial.
  simpl.
  rewrite -> IHl.
  trivial.
Qed.

(* 10.2 *)
Lemma L2 : forall (A : Set) (l : list A) (a : A), ~(cons A a l) = nil A.
Proof.
  discriminate.
Qed.

(* 10.3 *)
Lemma L3 : forall (A : Set) (l m : list A) (a : A),
           cons A a (append A l m) = append A (cons A a l) m.
Proof.
  trivial.
Qed.

(* 10.4 *)
(*
Fixpoint length (A:Set) (xs : list A) : nat :=
  match xs with
        nil => 0
      | cons y ys => S (length A ys)
  end.
*)
Lemma L4 : forall (A : Set) (l m : list A),
           length A (append A l m) = Sum (length A l) (length A m).
Proof.
  intros.
  induction l.
  elim SumConm.
  simpl.
  trivial.
  simpl.
  rewrite -> IHl.
  elim SumS.
  simpl.
  trivial.
Qed.

(* 10.5 *)
Lemma L5 : forall (A : Set) (l : list A), length A (reverse A l) = length A l.
Proof.
  intros.
  induction l; simpl.
  trivial.
  rewrite <- IHl.
  rewrite -> L4.
  simpl.
  trivial.
Qed.

(* Lema auxiliar (Ojo, igual a L9) *)
Lemma L6Aux: forall (A : Set) (l m p: list A),
      append A l (append A m p) = append A (append A l m) p.
Proof.
  intros.
  induction l; simpl.
  trivial.
  rewrite -> IHl.
  trivial.
Qed.

(* 10.6 *)
Lemma L6 : forall (A : Set) (l m : list A),
reverse A (append A l m) = append A (reverse A m) (reverse A l).
Proof.
  intros.
  induction l; simpl.
  rewrite -> L1.
  trivial.
  rewrite -> IHl.
  induction m; simpl.
  trivial.
  rewrite -> L6Aux.
  trivial.
Qed.

End Ejercicio10.
(*--------------------------------------------------------*)
(*----------------------SE ENTREGA------------------------*)
Section Ejercicio11.

(* 11.1 *)
Lemma L7 : forall (A B : Set) (l m : list A) (f : A -> B),
           map A B f (append A l m) = append B (map A B f l) (map A B f m).
Proof.
  intros.
  induction l; simpl.
  trivial.
  rewrite -> IHl.
  trivial.
Qed.

(* 11.2 *)
Lemma L8 : forall (A : Set) (l m : list A) (P : A -> bool),
           filter A P (append A l m) = append A (filter A P l) (filter A P m).
Proof.
  intros.
  induction l; simpl.
  trivial.
  rewrite -> IHl.
  case (P a); simpl; trivial.
Qed.

(* 11.3 *)
Lemma L9 : forall (A : Set) (l m n : list A),
                  append A l (append A m n) = append A (append A l m) n.
Proof.
  exact L6Aux.
Qed.

(* 11.4 *)
Lemma L10 : forall (A : Set) (l : list A), reverse A (reverse A l) = l.
Proof.
  intros.
  induction l; simpl.
  trivial.
  rewrite -> L6.
  simpl.
  rewrite -> IHl.
  trivial.
Qed.

End Ejercicio11.
(*--------------------------------------------------------*)
(*----------------------SE ENTREGA------------------------*)
Section Ejercicio12.

Fixpoint filterMap (A B : Set) (P : B -> bool) (f : A -> B)
         (l : list A) {struct l} : list B :=
         match l with
             | nil => nil B
             | cons a l1 => match P (f a) with
                                | true => cons B (f a) (filterMap A B P f l1)
                                | false => filterMap A B P f l1
                            end
         end.

Lemma FusionFilterMap :
      forall (A B : Set) (P : B -> bool) (f : A -> B) (l : list A),
      filter B P (map A B f l) = filterMap A B P f l.
Proof.
  intros.
  induction l; simpl.
  trivial.
  rewrite -> IHl.
  trivial.
Qed.

End Ejercicio12.
(*--------------------------------------------------------*)

Section Ejercicio13.

Lemma L11: forall (A : Set) (t : bintree A), mirror A t (inverse A t).
Proof.
  intros.
  induction t; simpl; constructor; assumption.
Qed.

End Ejercicio13.

Section Ejercicio14.

Print isomorfo.

Definition id_arbol (A : Set) (t : bintree A) : bintree A := t.

Lemma L12 : forall (A : Set) (t : bintree A), isomorfo A A (id_arbol A t) t.
Proof.
  intros.
  unfold id_arbol.
  induction t; constructor; assumption.
Qed.

Lemma isoReflexiva : forall (A : Set) (t : bintree A), isomorfo A A t t.
Proof.
  intros.
  replace (isomorfo A A t t) with (isomorfo A A (id_arbol A t) t).
  apply L12.
  unfold id_arbol.
  trivial.
Qed.

Lemma isoSimetrica : forall (A B : Set) (t1 : bintree A) (t2 : bintree B),
                     isomorfo A B t1 t2 -> isomorfo B A t2 t1.
Proof.
  intros.
  elim H.
  constructor.
  intros.
  constructor; assumption.
Qed.

End Ejercicio14.

Section Ejercicio15.

Inductive Tree (A:Set) : Set :=
                nilT : A -> Tree A
              | consT : Tree A -> Tree A -> Tree A.

Fixpoint mapTree (A B:Set) (f : A -> B) (t : Tree A) : Tree B :=
  match t with
        nilT a => nilT B (f a)
      | consT t1 t2 => consT B (mapTree A B f t1) (mapTree A B f t2)
  end.

Fixpoint countTree (A : Set) (t : Tree A) : nat :=
  match t with
        nilT a => 1
      | consT t1 t2 => Sum (countTree A t1) (countTree A t2)
  end.

Lemma L13 : forall (A B: Set) (f : A -> B) (t : Tree A),
            countTree B (mapTree A B f t) = countTree A t.
Proof.
  intros.
  induction t; simpl.
  trivial.
  rewrite -> IHt1.
  rewrite -> IHt2.
  trivial.
Qed.

Fixpoint hojasTree (A : Set) (t: Tree A) : list A :=
  match t with
        nilT a => cons A a (nil A)
      | consT t1 t2 => append A (hojasTree A t1) (hojasTree A t2)
  end.

Lemma L14 : forall (A : Set) (t : Tree A),
            length A (hojasTree A t) = countTree A t.
Proof.
  intros.
  induction t; simpl.
  trivial.
  rewrite -> L4.
  rewrite -> IHt1.
  rewrite -> IHt2.
  trivial.
Qed.

End Ejercicio15.

(*----------------------SE ENTREGA------------------------*)
Section Ejercicio16.

(* Set Implicit Arguments *)

Variable A : Set.

Inductive posfijo : list A -> list A -> Prop :=
   pos1 : forall (l : list A), posfijo l l
 | pos2 : forall (a:A) (l1 l2 : list A),
          posfijo l1 l2 -> posfijo l1 (cons A a l2).

Infix "<<" := posfijo (at level 2).
Infix "+++" := (append A) (at level 1).
(*
No puedo hacerla infija porque requiere 3 argumentos
Infix "++" :=  append.
Infix "<<" := posfijo (at level 93).
*)
Lemma L15 : forall (l1 l2 l3 : list A),
            l2 = l3 +++ l1 -> l1 << l2.
Proof.
  intros.
  rewrite H.
  clear H.         (* Si no pongo esto, me cambia la hipótesis inductiva *)
  induction l3; simpl.
  constructor.
  constructor.
  assumption.
Qed.

Lemma L16 : forall (l2 l1 : list A), posfijo l1 l2 ->
            exists l3 : list A, l2 = append A l3 l1.
Proof.
  intros.
  induction H; simpl.
  exists (nil A).
  simpl.
  trivial.
  elim IHposfijo.
  intros.
  exists (cons A a x).
  simpl.
  rewrite <- H0.
  trivial.
Qed.

Fixpoint ultimo (l : list A) : list A :=
  match l with
        nil => nil A
      | cons a nil => cons A a (nil A)
      | cons a xs => ultimo xs
  end.

Lemma L17 : forall (l : list A), (ultimo l) << l.
Proof.
  intros.
  induction l.
  simpl.
  constructor.
  destruct l; constructor.
  assumption.
(*
  intros.
  induction l.
  simpl.
  constructor.
  destruct l.
  simpl.
  constructor.

  replace (ultimo (cons A a (cons A a0 l))) with (ultimo (cons A a0 l)).
  constructor.
  assumption.
  simpl.
  trivial. *)
Qed.

End Ejercicio16.
(*--------------------------------------------------------*)

Section Ejercicio17.

Inductive ABin (A B : Set) : Set :=
                nilAB  : B -> ABin A B
              | consAB : A -> ABin A B -> ABin A B -> ABin A B.

Fixpoint countExternal (A B : Set) (t : ABin A B) : nat :=
  match t with
        nilAB b => 1
      | consAB a t1 t2 => Sum (countExternal A B t1) (countExternal A B t2)
  end.

Fixpoint countInternal (A B : Set) (t : ABin A B) : nat :=
  match t with
        nilAB b => 0
      | consAB a t1 t2 => S (Sum (countInternal A B t1) (countInternal A B t2))
  end.

Lemma L18 : forall (A B : Set) (t : ABin A B),
            countExternal A B t = 1 + countInternal A B t.
Proof.
  induction t; simpl.
  trivial.
  rewrite IHt1.
  rewrite IHt2.
  elim SumS.
  simpl.
  trivial.
Qed.

End Ejercicio17.

(*----------------------SE ENTREGA------------------------*)
Section Ejercicio18.

Variable A : Set.

Inductive Tree_ : Set :=
  | nullTT : Tree_
  | consTT : A -> Tree_ -> Tree_ -> Tree_ .

Inductive isSubtree : Tree_ -> Tree_ -> Prop :=
  | isSub1 : forall t : Tree_ , isSubtree t t
  | isSub2 : forall (a : A) (t1 t2 t3 : Tree_),
             isSubtree t1 t2 -> isSubtree t1 (consTT a t2 t3)
  | isSub3 : forall (a : A) (t1 t2 t3 : Tree_),
             isSubtree t1 t3 -> isSubtree t1 (consTT a t2 t3).

Lemma L19 : forall t : Tree_, isSubtree t t.
Proof.
  constructor.
Qed.

Lemma L20 : forall t1 t2 t3 : Tree_,
            isSubtree t1 t2 /\ isSubtree t2 t3 -> isSubtree t1 t3.
Proof.
  intros.
  elim H; intros; clear H.
  induction H1.
  assumption.

  apply isSub2.
  apply IHisSubtree.
  assumption.

  apply isSub3.
  apply IHisSubtree.
  assumption.
Qed.

End Ejercicio18.
(*--------------------------------------------------------*)

(*----------------------SE ENTREGA------------------------*)
Section Ejercicio19.

Variable A : Set.

Inductive ACom : nat -> Set :=
  | hojaCom : A -> ACom 0
  | consCom : forall n : nat, A -> ACom n -> ACom n -> ACom (S n).

Fixpoint cantHojasACom (n:nat) (t : ACom n) : nat :=
  match t with
        hojaCom a => 1
      | consCom p a t1 t2 =>
          Sum (cantHojasACom p t1) (cantHojasACom p t2)
  end.

Parameter pot: nat -> nat -> nat.

(* n^0 = 1, n>0 *)
Axiom potO : forall n : nat, pot (S n) 0 = 1.

(* 2^(m+1) = 2^m + 2^m *)
Axiom potS : forall m: nat, pot 2 (S m) = Sum (pot 2 m) (pot 2 m).

Lemma L21 : forall (n : nat) (t : ACom n), cantHojasACom n t = pot 2 n.
Proof.
  induction t; simpl.
  rewrite -> potO.
  trivial.
  rewrite -> IHt1.
  rewrite -> IHt2.
  rewrite -> potS.
  trivial.
Qed.

End Ejercicio19.
(*--------------------------------------------------------*)

(*----------------------SE ENTREGA------------------------*)
Section Ejercicio20.

(* Funciones auxiliares *)
Fixpoint GeBool (m n : nat) {struct n} : bool :=
  match n with
    | O => true
    | S k => match m with
                 | O => false
                 | S k2 => GeBool k2 k
                   end
  end.

Fixpoint Max (m n : nat) : nat :=
  match GeBool m n with
    | true => m
    | false => n
  end.
(* ------------------- *)

Inductive AB (A:Set) : nat -> Set :=
                nullAB : AB A 0
              | constAB : forall (m n : nat), A -> AB A m -> AB A n -> AB A (S (Max m n)).

Fixpoint camino (A: Set) (n: nat) (t : AB A n) : list A :=
  match t with
        nullAB => nil A
      | constAB n1 n2 a t1 t2 => match (GeBool n1 n2) with
                                       true => cons A a (camino A n1 t1)
                                     | false => cons A a (camino A n2 t2)
                                 end
  end.

Lemma AuxIfLength : forall (c : bool) (A:Set) (l1 l2 : list A),
      length A (if c then l1 else l2) = if c then length A l1 else length A l2.
Proof.
  induction c; trivial.
Qed.

Lemma CaminoN : forall (A: Set) (n : nat) (t : AB A n),
                length A (camino A n t) = n.
Proof.
  induction t; simpl.
  trivial.
  rewrite AuxIfLength.
  simpl.
  rewrite IHt1.
  rewrite IHt2.
  destruct m; destruct n; simpl; trivial.
  case (GeBool m n); trivial.
Qed.

End Ejercicio20.
(*--------------------------------------------------------*)


(** INITIATION A LΑ RÉCURRENCE EN COQ *)

(*
Le TD est destiné à exprimer en Coq la preuve par récurrence
sur les expressions arithmétiques vue au TD1.
*)

(**
Attention : il faut être capable de rédiger sous forme de texte usuel
le raisonnement formalisé en Coq, soit avant, soit a posteriori.
*)

(** * Expressions arithmétiques *)

(** ** Définitions *)

(** On considère une variante simplifiée des expressions arithmétiques vues en cours/TD,
    ne comportant des opérateurs que pour l'addition et la multiplication.
    On utilisera le type nat (entiers naturels de Coq) pour représenter les entiers
    et on nommera les différents constructeurs/opérateurs
    Cst (pour les naturels), Apl et Amu pour l'addition et la multiplication *)

Inductive aexp : Set :=
| Cst: nat -> aexp
| Apl : aexp -> aexp -> aexp
| Amu : aexp -> aexp -> aexp.

(* Définir les expressions aexp correspondant à
  (1 + 2) * 3 et  (1 * 2) + 3
 *)

Definition exp_1 := Amu (Apl (Cst 1) (Cst 2)) (Cst 3).

Definition exp_2 :=  Apl (Amu (Cst 1) (Cst 2)) (Cst 3).

(** Définir en Coq la fonction d'évaluation sémantique fonctionnelle Sf de aexp
    en utilisant les operateurs arithmétiques de Coq sur le type nat : + *       *)

Fixpoint eval (a: aexp) : nat :=
  match a with
  | Cst n => n
  | Apl e1 e2 => (eval e1) + (eval e2)
  | Amu e1 e2 => (eval e1) * (eval e2)
  end.

(** Evaluer avec Eval ou Compute la sémantique de exp_1 et exp_2 *)

(* à compléter *)
Eval compute in (eval exp_1).
Compute (eval exp_2).

(** Nombre de feuilles *)

(** Définir en Coq la fonction de calcul du nombre de feuilles dans un
    arbre d'expression (c'est-à-dire le nombre de constantes de
    l'expression) *)

Fixpoint nbf (a:aexp) :=
  match a with
    (* à compléter *)
    | Cst n => 1
    | Apl e1 e2 => nbf e1 + nbf e2
    | Amu e1 e2 => nbf e1 + nbf e2
  end.

Compute (nbf exp_1).
Compute (nbf exp_2).

(** ** Raisonnement par cas sur un AST *)

(** Écrire une fonction qui transforme une expression
   (ou plus exactement un AST d'expression) de la façon suivante :
   - si l'expression représente une constante, rendre la constante 1
   - si l'expression représente une somme, rendre la constante 2
   - si l'expression représente un produit, rendre la constante 3
 *)

Definition categorise (a:aexp) :=
  match a with
    (* à compléter *)
    | Cst n => Cst 1
    | Apl e1 e2 => Cst 2
    | Amu e1 e2 => Cst 3
  end.

(** Démontrer que le résultat de la fonction précédente
    rend un AST de taille 1 au sens de nbf.
    Raisonner par cas en utilisant la tactique destruct.
 *)

Lemma nbf_cat : forall a, nbf (categorise a) = 1.
Proof.
(* à compléter *)
  intro a0.
  destruct a0 as [(*Cst*) n |
                   (*Apl*) e1 e2 |
                   (*Amu*) e1 e2].
  - cbn [categorise]. cbn [nbf]. reflexivity.
  - cbn [categorise]. cbn [nbf]. reflexivity.
  - cbn [categorise]. cbn [nbf]. reflexivity.
Qed.

(** Nombre d'opérateurs *)

(** Définir en Coq la fonction de calcul du nombre de noeuds dans un
    arbre d'expression (c'est-à-dire le nombre d'opérateurs binaires de
    l'expression) *)

Fixpoint nbo (a:aexp) :=
  match a with
    (* à compléter *)
    | Cst n => 0
    | Apl e1 e2 => nbo e1 + 1 + nbo e2
    | Amu e1 e2 => nbo e1 + 1 + nbo e2
  end.

Compute (nbo exp_1).
Compute (nbo exp_2).

(** Démontrer la relation entre nbf et nbo par récurrence structurelle *)

(** On utilisera dans la suite quelques lemmes simples d'arithmétique *)

Require Import Arith. Import Nat.
Check add_assoc.

Lemma nbf_nbo_plus_1: forall a:aexp, nbf a = nbo a + 1.
Proof.
  intro a.
  induction a as [ (*Cst*) n
                 | (*Apl*) e1 Hrec_e1 e2 Hrec_e2
                 | (*Amu*) e1 Hrec_e1 e2 Hrec_e2 ].

  (* à compléter *)
  - cbn [nbf]. cbn [nbo]. reflexivity.
  - cbn [nbf]. cbn [nbo].  rewrite Hrec_e1. rewrite Hrec_e2. rewrite add_assoc. reflexivity.
  - cbn [nbf]. cbn [nbo]. rewrite Hrec_e1. rewrite Hrec_e2. rewrite add_assoc. reflexivity.
Qed.

(** Transformation d'expressions *)

(* Écrire une fonction qui transforme une expression
 * en remplaçant toutes les constantes par 1
 * et tous les opérateurs binaires par +
 *)

Fixpoint transform (a:aexp) :=
  (* à compléter *)
  match a with
  | Cst n => Cst 1
  | Apl e1 e2 => Apl (transform e1) (transform e2)
  | Amu e1 e2 => Apl (transform e1) (transform e2)
  end.
(** Évaluer la fonction transform sur les expressions exp_1 et exp_2 *)

(* à compléter *)
Compute (transform exp_1).
Compute (transform exp_2).
Compute (eval (transform exp_1)).
Compute (nbf (exp_1)).
(** Montrer maintenant que l'évaluation de transform e donne le nombre
 * de feuilles de e (nbf e). *)

Lemma eval_transform_nbf : forall a, eval (transform a) = nbf a.
Proof.
  (* à compléter *)
  intro a0.
  induction a0 as [(*Cst*) n
                   |(*Apl*) e1 Hrec_e1 e2 Hrec_e2
                   |(*Amu*) e1 Hrec_e1 e2 Hrec_e2].
  - cbn [transform]. cbn [eval]. cbn [nbf]. reflexivity.
  - cbn [transform]. cbn [eval]. cbn [nbf]. rewrite Hrec_e1. rewrite Hrec_e2. reflexivity.
  - cbn [transform]. cbn [eval]. cbn [nbf]. rewrite Hrec_e1. rewrite Hrec_e2. reflexivity.
Qed.

(** Simplification d'expressions *)

(* Définir ici la fonction simpl0 du TD1 *)

Definition simpl0 (a:aexp) :=
  match a with
  (* à compléter *)
  | Apl (Cst 0) e2 => e2
  | Amu (Cst 0) e2 => Cst 0
  (* fin de zone à compléter *)
  | _ => a
  end.

(* ------------------------------------------------------------------------------- *)
(*                     LΑ SUITE EST FACULTATIVE POUR LE DM.                        *)
(*                                                                                *)
(* Vous êtes bien sûr encouragés à la faire si vous êtes à l'aise avec ce qui a    *)
(* été vu jusqu'ici.                                                               *)
(* ------------------------------------------------------------------------------- *)

(* Prouver que simpl0 préserve le résultat de l'évaluation *)

(* On introduit une tactique utilisateur signifiant :
   prouver les cas "0 + e2" et "0 * e2",
   considérant à l'avance que tous les autres cas se prouvent par simplification et
   réflexivité.
   A ce stade on va simplement utiliser cette tactique, son fonctionnement
   sera expliqué plus tard.
*)
Ltac cas_simpl0 e :=
  refine ( match e with
           | Apl (Cst 0) e2 => _
           | Amu (Cst 0) e2 => _
           | _ => eq_refl _
           end).

(** Deux lemmes utiles *)
Check add_0_l.
Check mul_0_l.

Lemma eval_simpl0: forall a, eval (simpl0 a) = eval a.
Proof.
  intro a. cas_simpl0 a.
  - cbn [simpl0]. cbn [eval]. rewrite add_0_l. reflexivity.
    (* à compléter *)
  - cbn [simpl0]. cbn [eval]. rewrite mul_0_l. reflexivity.
Qed.

(* écrire la fonction simpl_rec qui applique récursivement simpl0 à toutes les sous-expressions. *)

Fixpoint simpl_rec (a:aexp) :=
  (* à compléter *)
  match a with
  | Cst n => Cst n
  | Apl e1 e2 => simpl0 (Apl (simpl_rec e1) (simpl_rec e2))
  | Amu e1 e2 => simpl0 (Amu (simpl_rec e1) (simpl_rec e2))
  end.

(* Prouver que simpl_rec préserve l'évaluation des expressions *)

Lemma eval_simpl_rec: forall a, eval(simpl_rec a) = eval a.
Proof.
  (* à compléter *)
  intro a0.
  induction a0 as [(*Cst*) n
                 | (*Apl*) e1 Hrec_e1 e2 Hrec_e2
                 |(*Amu*) e1 Hrec_e1 e2 Hrec_e2].
  - cbn [simpl_rec]. reflexivity.
  - cbn [simpl_rec].
Admitted.


Goal forall (n : nat), n = n + 0.
  intros.
  induction n.
  reflexivity.
  simpl.
  f_equal.
  apply IHn.
Qed.

Require Import Arith.
Goal forall (n : nat), (exists m : nat,  n = m * 4) -> (exists k : nat, n = k * 2).
  intros.
  destruct H.
  exists (x * 2).
  rewrite mult_assoc_reverse.
  simpl.
  apply H.
Qed.

Require Import Arith.

Theorem lt_Snm_nm : forall (n m : nat), S n < m -> n < m.
  intros.
  rewrite lt_n_Sn.
  apply H.
Qed.

Inductive InList (A : Type)(a : A) : list A -> Prop :=
  | headIL : forall xs, InList A a (a :: xs)
  | consIL : forall x xs, InList A a xs -> InList A a (x :: xs).

Require Import List.
Require Import Arith.
Theorem pigeonhole : forall (xs : list nat),
    length xs < fold_right plus 0 xs -> exists x : nat, InList nat (S (S x)) xs.
  intros.
  induction xs.
  simpl in H.
  apply False_ind.
  apply (lt_n_O 0).
  apply H.
  simpl in H.
  destruct a.
  apply lt_Snm_nm in H.
  apply IHxs in H.
  destruct H.
  exists x.
  constructor.
  apply H.
  destruct a.
  simpl in H.
  apply lt_S_n in H.
  apply IHxs in H.
  destruct H. (* H : exists x : ... の時に exists を外すために使う*)
  exists x.
  constructor.
  apply H.
  exists a.
  constructor.
Qed.

Goal forall (n : nat), 0 = n * 0.
trivial.
Qed.

(*
Goal forall (n : nat), 0 = n * 0.
  intros.
  destruct 0.
  simpl.
  reflexivity.
  simpl.

Qed.
 *)

Goal forall (n m : nat), n * m = m * n.
auto with arith.
Qed.

(*
Goal forall (n m : nat), n * m = m * n.
  intros.
  destruct n.
Qed.
 *)

Require Import Omega.
Goal forall n m, 1 + 2 * n = 2 * m -> False.
intros.
omega.
Qed.

(*
Goal forall n m, 1 + 2 * n = 2 * m -> False.
intros.
omega.
Qed.
 *)


Module Church.
Definition cnat := forall X : Type, (X -> X) -> X -> X.

(* \f\x.x *)
Definition zero : cnat :=
  fun (X : Type)(f : X -> X)(x : X) => x.

(* \f\x.f x *)
Definition one : cnat :=
  fun (X : Type)(f : X -> X)(x : X) => f x.

(* \f\x.f (f x) *)
Definition two : cnat :=
  fun (X : Type)(f : X -> X)(x : X) => f (f x).

(* \f\x.f (f (f x)) *)
Definition three : cnat :=
  fun (X : Type)(f : X -> X)(x : X) => f (f (f x)).

Definition succ(n: cnat) : cnat :=
  fun (X: Type) (f: X -> X) (x : X) => f (n X f x).

Compute succ one.

Definition plus(m n: cnat) : cnat :=
  fun (X: Type) (f: X -> X) (x : X) => m X f (n X f x).

Example zero_plus_one : plus zero one = one.
Proof. reflexivity. Qed.

Example two_p_three_eq_three_p_two : plus two three = plus three two.
Proof. reflexivity. Qed.

Example assoc_test : plus one (plus two three) = plus (plus one two) three.
Proof. reflexivity. Qed.

Definition multiply(m n: cnat) : cnat :=
  fun (X: Type) (f: X -> X) (x : X) => m X (n X f) x.

Definition cbool := forall X : Type, X -> X -> X.

Definition true : cbool :=
  fun (X : Type) (t f: X) => t.

Definition false : cbool :=
  fun (X : Type) (t f: X) => f.

Definition not (b : cbool) :=
  fun (X : Type) (t f: X) => b X f t.

Example not_involutive : not (not true) = true.
Proof. reflexivity. Qed.

Definition and (b c : cbool) :=
  fun (X: Type) (t f: X) => b X (c X t f) f.

Definition or (b c : cbool) :=
  fun (X: Type) (t f: X) => b X t (c X t f).

Example and_comm : and true false = and false true.
Proof. reflexivity. Qed.

Definition xor (b c : cbool) :=
  fun (X: Type) (t f: X) => b X ((not c) X t f) (c X t f).

Example xor_test : xor true true = false.
Proof. reflexivity. Qed.

End Church.


Require Import ZArith.
(*Require Import Coq.Arith.Even. *)
Require Import Nat.
Open Scope Z_scope.
Require Import FunInd.

Fixpoint power (x:Z)(n:nat):=
  match n with 0%nat => 1
          | S p => x * power x p
  end.

Compute power 2 40.
Search nat.
(*
Function binary_power_mult (acc x:Z)(n:nat)
         {measure (fun i=>i) n} : Z
(* acc * (power x n) *) :=
  match n with 0%nat => acc
          | _ => if Nat.Even n Nat.Odd n
                 then binary_power_mult
                        acc (x * x) (Nat.div2 n)
                 else binary_power_mult
                        (acc * x) (x * x) (Nat.div2 n)
  end.
Proof.
  intros; apply lt_div2; auto with arith.
  intros; apply lt_div2; auto with arith.
Defined.
*)

Fixpoint sum_odd_n (n:nat) : nat :=
  match n with
    O => O
  | S p => 1 + 2*p + sum_odd_n p
  end.
Search (Nat.mul).

Lemma sum_odd_n_p : forall (n:nat), sum_odd_n (n:nat) = n*n.
  induction n.
  simpl. reflexivity.
  simpl. rewrite IHn. ring.


Inductive light : Set :=
  | Blue   : light
  | Yellow : light
  | Red    : light.

Definition next x :=
  match x with
    | Blue   => Yellow
    | Yellow => Red
    | Red    => Blue
  end.

Check next Yellow.
Eval compute in next Yellow.

Theorem light_cycles : forall (l : light), next (next (next l)) = l.
Proof.
  intros l.
  destruct l.
  (* Blue *)
  simpl.
  reflexivity.

  (* Yellow *)
  simpl.
  reflexivity.

  (* Red *)
  simpl.
  reflexivity.
Qed.


Definition even (n : nat) := exists k, n = k + k.
Definition odd (n : nat) := exists k, n = S (k + k).

Axiom double_negation : forall P, P = ~~P.

Lemma contrapositive : forall P Q : Prop, (P -> Q) -> (~Q -> ~P).
Proof. intuition. Qed.

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

Lemma plus_n_Sm : forall n m, n + S m = S n + m.
Proof.
  intros n m.
  induction n as [|n' IHn]. reflexivity.
  simpl. rewrite IHn. reflexivity.
Qed.

Lemma plus_commutative : forall n m, n + m = m + n.
Proof.
  intros n m.
  induction n as [|n' IHn]. rewrite plus_n_0. reflexivity.
  rewrite plus_n_Sm. simpl. rewrite IHn. reflexivity.
Qed.

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

Lemma plus_result_0 : forall n m, n + m = 0 <-> n = 0 /\ m = 0.
Proof.
  intros n m.
  split.
  - intros H.
    destruct n as [|n'] eqn : En.
    + destruct m as [|m'] eqn : Em.
      * split. reflexivity. reflexivity.
      * discriminate H.
    + discriminate H.
  - intros [Hl Hr].
    rewrite Hl, Hr.
    reflexivity.
Qed.

Lemma mult_n_0 : forall n, n * 0 = 0.
Proof.
  intros n.
  induction n as [|n' IHn]. reflexivity.
  simpl. apply IHn.
Qed.

Lemma mult_1_n : forall n, 1 * n = n.
Proof. intros n. simpl. rewrite plus_n_0. reflexivity. Qed.

Lemma mult_n_1 : forall n, n * 1 = n.
Proof.
  intros n.
  induction n as [|n' IHn]. reflexivity.
  simpl. rewrite IHn. reflexivity.
Qed.

Lemma mult_n_Sm : forall n m, n * S m = n + n * m.
Proof.
  intros n m.
  induction n as [|n' IHn]. reflexivity.
  simpl. rewrite IHn.
  rewrite <- (plus_associative m n' _).
  rewrite (plus_commutative m n').
  rewrite (plus_associative n' m _).
  reflexivity.
Qed.

Lemma mult_commutative : forall n m, n * m = m * n.
Proof.
  intros n m.
  induction n as [|n' IHn]. rewrite mult_n_0. reflexivity.
  simpl. rewrite mult_n_Sm. rewrite IHn. reflexivity.
Qed.

Lemma mult_left_distributive : forall n m o, n * (m + o) = n * m + n * o.
Proof.
  intros n m o.
  induction n. reflexivity.
  simpl. rewrite IHn.
  rewrite (plus_associative m (n * m) _).
  rewrite <- (plus_associative (n * m) o (n * o)).
  rewrite (plus_commutative (n * m) o).
  rewrite (plus_associative o (n * m) _).
  rewrite (plus_associative m o _).
  reflexivity.
Qed.

Lemma mult_right_distributive : forall n m o, (n + m) * o = n * o + m * o.
Proof.
  intros n m o.
  induction o as [|o' IHo].
  - rewrite mult_n_0.
    rewrite (mult_n_0 n).
    rewrite (mult_n_0 m).
    reflexivity.
  - rewrite mult_n_Sm.
    rewrite (mult_n_Sm n).
    rewrite (mult_n_Sm m).
    rewrite IHo.
    rewrite (plus_associative n (n * o') _).
    rewrite <- (plus_associative (n * o') m _).
    rewrite (plus_commutative (n * o') m).
    rewrite (plus_associative m (n * o')).
    rewrite (plus_associative n m _).
    reflexivity.
Qed.

Lemma mult_associative : forall n m o, (n * m) * o = n * (m * o).
Proof.
  intros n m o.
  induction n. reflexivity.
  simpl. rewrite <- IHn. apply mult_right_distributive.
Qed.

Lemma mult_result_0 : forall n m, n * m = 0 <-> n = 0 \/ m = 0.
Proof.
  intros n m.
  split.
  - intros H.
    destruct n as [|n'] eqn : En.
    + left. reflexivity.
    + right. destruct m as [|m'] eqn : Em.
      * reflexivity.
      * simpl in H.
        discriminate H.
  - intros [Hl | Hr].
    + rewrite Hl. reflexivity.
    + rewrite Hr. apply mult_n_0.
Qed.

Lemma even_n__even_SSn : forall n, even n -> even (S (S n)).
Proof.
  intros n H.
  induction H.
  exists (S x).
  simpl.
  rewrite plus_n_Sm.
  rewrite H.
  reflexivity.
Qed.

Lemma odd_n__odd_SSn : forall n, odd n -> odd (S (S n)).
Proof.
  intros n H.
  induction H.
  exists (S x).
  simpl.
  rewrite plus_n_Sm.
  rewrite H.
  reflexivity.
Qed.

Lemma even_SSn__even_n : forall n, even (S (S n)) -> even n.
Proof.
  intros n H.
  induction H.
  assert(H' : exists k, x = S k). {
    induction x as [|x' IHx].
    - discriminate H.
    - exists x'. reflexivity.
  }
  destruct H' as [k H'].
  exists k.
  rewrite H' in H.
  rewrite plus_n_Sm in H.
  simpl in H.
  inversion H.
  reflexivity.
Qed.

Lemma odd_SSn__odd_n : forall n, odd (S (S n)) -> odd n.
Proof.
  intros n H.
  inversion H.
  assert(H' : exists k, x = S k). {
    induction x as [|x' IHx].
    - discriminate H0.
    - exists x'. reflexivity.
  }
  destruct H' as [k H'].
  exists k.
  rewrite H' in H0.
  rewrite plus_n_Sm in H0.
  simpl in H0.
  inversion H0.
  reflexivity.
Qed.

Lemma even_n__not_odd_n : forall n, even n -> ~odd n.
Proof.
  intros n [k H]. generalize dependent n.
  induction k as [|k' IHk].
  - intros n H.
    rewrite H.
    intros [x H'].
    inversion H'.
  - intros n H.
    rewrite H.
    rewrite plus_n_Sm.
    simpl.
    assert(H'' : forall a, ~odd (S (S a)) <-> ~odd a). {
      intros a. split.
      - intros H'' H'''.
        apply odd_n__odd_SSn in H'''.
        apply H'' in H'''.
        apply H'''.
      - intros H'' H'''.
        apply odd_SSn__odd_n in H'''.
        apply H'' in H'''.
        apply H'''.
    }
    apply H''.
    apply IHk.
    reflexivity.
Qed.

Lemma odd_n__not_even_n : forall n, odd n -> ~even n.
Proof.
  intros n [k H]. generalize dependent n.
  induction k as [| k' IHk].
  - intros n H.
    rewrite H.
    intros [x H'].
    destruct x. inversion H'.
    rewrite plus_n_Sm in H'. inversion H'.
  - intros n H.
    rewrite H.
    rewrite plus_n_Sm.
    simpl.
    assert(H'' : forall a, ~even (S (S a)) <-> ~even a). {
      intros a. split.
      - intros H'' H'''.
        apply even_n__even_SSn in H'''.
        apply H'' in H'''.
        apply H'''.
      - intros H'' H'''.
        apply even_SSn__even_n in H'''.
        apply H'' in H'''.
        apply H'''.
    }
    apply H''.
    apply IHk.
    reflexivity.
Qed.

Lemma even_n__odd_Sn : forall n, even n -> odd (S n).
Proof.
  intros n [k H].
  exists k.
  rewrite H.
  reflexivity.
Qed.

Lemma odd_n__even_Sn : forall n, odd n -> even (S n).
Proof.
  intros n [k H].
  exists (S k).
  rewrite H, plus_n_Sm.
  reflexivity.
Qed.

Lemma odd_n__not_odd_Sn : forall n, odd n -> ~odd (S n).
Proof.
  intros n H.
  apply odd_n__even_Sn in H.
  apply even_n__not_odd_n in H.
  apply H.
Qed.

Lemma even_n__not_odd_Sn : forall n, even n -> ~even (S n).
Proof.
  intros n H.
  apply even_n__odd_Sn in H.
  apply odd_n__not_even_n in H.
  apply H.
Qed.

Lemma even_Sn__odd_n : forall n, even (S n) -> odd n.
Proof.
  intros n [[|k] H].
  - discriminate H.
  - exists k.
    rewrite plus_n_Sm in H.
    inversion H.
    reflexivity.
Qed.

Lemma odd_Sn__even_n : forall n, odd (S n) -> even n.
Proof.
  intros n [[|k] H].
  - inversion H.
    exists 0.
    reflexivity.
  - exists (S k).
    inversion H.
    reflexivity.
Qed.

Lemma even_Sn__not_even_n : forall n, even (S n) -> ~even n.
Proof.
  intros n H.
  apply even_Sn__odd_n in H.
  apply odd_n__not_even_n in H.
  apply H.
Qed.

Lemma odd_Sn__not_odd_n : forall n, odd (S n) -> ~odd n.
Proof.
  intros n H.
  apply odd_Sn__even_n in H.
  apply even_n__not_odd_n in H.
  apply H.
Qed.

Lemma not_odd_n__odd_Sn : forall n, ~odd n -> odd (S n).
Proof.
  intros n.
  induction n as [|n' IHn].
  - exists 0. reflexivity.
  - intros H. apply odd_n__odd_SSn.
    apply contrapositive in IHn.
    rewrite <- double_negation in IHn.
    apply IHn.
    apply H.
Qed.

Lemma not_even_n__even_Sn : forall n, ~even n -> even (S n).
Proof.
  intros n H.
  induction n as [|n' IHn].
  - assert(H' : even 0). exists 0. reflexivity.
    apply H in H'.
    destruct H'.
  - apply even_n__even_SSn.
    apply contrapositive in IHn.
    rewrite <- double_negation in IHn.
    apply IHn.
    apply H.
Qed.

Lemma not_odd_n__even_n : forall n, ~odd n -> even n.
Proof.
  intros n H.
  apply not_odd_n__odd_Sn in H.
  apply odd_Sn__even_n.
  apply H.
Qed.

Lemma not_even_n__odd_n : forall n, ~even n -> odd n.
Proof.
  intros n H.
  apply not_even_n__even_Sn in H.
  apply even_Sn__odd_n.
  apply H.
Qed.

Lemma not_odd_Sn__odd_n : forall n, ~odd (S n) -> odd n.
Proof.
  intros n H.
  apply not_odd_n__odd_Sn in H.
  apply odd_SSn__odd_n.
  apply H.
Qed.

Lemma not_even_Sn__even_n : forall n, ~even (S n) -> even n.
Proof.
  intros n H.
  apply not_even_n__even_Sn in H.
  apply even_SSn__even_n.
  apply H.
Qed.

Lemma nat_odd_or_even : forall n, even n \/ odd n.
Proof.
  intros n.
  induction n as [|n' [Hl | Hr]].
  - left. exists 0. reflexivity.
  - right. apply even_n__odd_Sn. apply Hl.
  - left. apply odd_n__even_Sn. apply Hr.
Qed.

Lemma odd_n__even_n__false : forall n, odd n /\ even n -> False.
Proof.
  intros n [Hl Hr].
  apply even_n__not_odd_n in Hr.
  apply Hr in Hl.
  apply Hl.
Qed.

Lemma even_n__even_m__even_plus_n_m : forall n m, even n /\ even m -> even (n + m).
Proof.
  intros n m [[l Hl] [r Hr]].
  rewrite Hl, Hr.
  rewrite <- plus_associative.
  rewrite (plus_commutative (l + l) r).
  rewrite <- plus_associative.
  rewrite (plus_commutative r l).
  exists (l + r).
  rewrite <- plus_associative.
  reflexivity.
Qed.

Lemma even_plus_n_m__even_n__even_m : forall n m, even (n + m) /\ even n -> even m.
Proof.
  intros n m [[l Hl] [r Hr]].
  induction l as [|l IHl].
  - apply plus_result_0 in Hl.
    destruct Hl as [Hll Hlr].
    exists 0. apply Hlr.
Qed.


(*
  Some exercises come from Software Foundations Book1 CH3.
  Author : Brethland.
*)

From Coq Require Import Setoid.

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

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

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

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

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

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

Lemma snd_fst_is_swap : forall p : natprod, (snd p, fst p) = swap p.
Proof.
  intros.
  destruct p as [n m].
  simpl.
  auto.
Qed.

Lemma fst_swap_is_snd : forall p : natprod, fst (swap p) = snd p.
Proof.
  intros.
  destruct p as [n m].
  simpl.
  auto.
Qed.

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 repeat (n count : nat) :natlist :=
  match count with
  | O => nil
  | S count' => cons n (repeat n count')
  end.

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

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

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

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

Definition tl(l : natlist) :=
  match l with
  | nil => nil
  | x :: y => y
  end.

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

Lemma beq_n_refl : forall n : nat, beq_n n n = true.
Proof.
  intros.
  induction n.
  - auto.
  - trivial.
Qed.

Fixpoint nonzero (l : natlist) :=
  match l with
  | nil => nil
  | x :: y => if beq_n x O then nonzero y
                            else x :: nonzero y
  end.

Fixpoint oddnumbers (l : natlist) :=
  match l with
  | nil => nil
  | x :: y => match evenb x with
                    | true => oddnumbers y
                    | false => x :: oddnumbers y
                    end
  end.

Definition conutoddnumbers (l : natlist) :=
  length (oddnumbers l).

Inductive tree a :=
  | leaf
  | node : tree a -> a -> tree a -> tree a.

Check nat_rect.
Check nat_ind.
Check nat_rec.

Check tree_ind.

Fixpoint alternative (l1 l2 : natlist ) :natlist :=
  match l1,l2 with
  | nil,_ => l2
  | _,nil => l1
  | x :: y , z :: p => x :: z :: (alternative y p)
  end.

Definition bag := natlist.

Fixpoint count (ele: nat) (s : bag) :=
  match s with
  | nil => O
  | x :: y => match beq_n ele x with
              | true => S (count ele y)
              | false => count ele y
            end
  end.

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

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

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

Fixpoint remove_one (v : nat) (s : bag) :=
  match s with
  | nil => nil
  | x :: y => match beq_n v x with
              | true => y
              | false => x :: (remove_one v y)
             end
  end.

Fixpoint remove_all (v : nat) (s : bag) :=
  match s with
  | nil => nil
  | x :: y => match beq_n v x with
              | true => (remove_all v y)
              | false => x :: (remove_all v y)
             end
  end.

Fixpoint subset (s1 s2 :bag) :=
  match s1 with
  | nil => true
  | x :: y => if member x s2 then subset y (remove_one x s2)
                              else false
  end.

Lemma add_and_cons: forall (x : nat) (s : bag), add x s = x :: s.
Proof.
  auto.
Qed.

(* Lemma add_1_for_count: forall (b : nat) (s : bag), count b s = 0 -> count b (add b s) = 1.
Proof.
  intros.
  destruct s.
  - simpl. rewrite <- H. simpl.
    induction b.
    + auto.
    + apply IHb. simpl. auto.
  - rewrite -> add_and_cons.

    induction b.
    + rewrite <- H. auto.
Abort. *)

Lemma silly_lemma_that_you_dont_need_if_you_use_std_lib : forall p : nat,
  beq_n p p = true.
Proof.
  intro.
  induction p.
  - trivial.
  - simpl.
    rewrite IHp.
    reflexivity.
Qed.

Lemma add_1_for_count: forall (b : nat) (s : bag),
  count b s = 0 -> count b (b :: s) = 1.
Proof.
  intros.
  unfold count.
  rewrite silly_lemma_that_you_dont_need_if_you_use_std_lib.
  fold count.
  rewrite H.
  auto.
Qed.

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

Compute (rev [1;2;3]).

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

Lemma silly_pred : forall n : nat, n + 1 = S n.
Proof.
  intros.
  induction n.
  - auto.
  - simpl.
    rewrite <- IHn.
    auto.
Qed.

Lemma rev_length : forall l : natlist,
  length l = length (rev l).
Proof.
  intros.
  induction l.
  - auto.
  - simpl.
    rewrite -> app_length,silly_pred.
    rewrite <- IHl.
    auto.
Qed.

Lemma app_nil_r : forall l : natlist, l ++ [] = l.
Proof.
  intros.
  induction l.
  - auto.
  - simpl.
    rewrite -> IHl.
    auto.
Qed.

Lemma app_assoc : forall l1 l2 l3 : natlist,
  l1 ++ (l2 ++ l3) = (l1 ++ l2) ++ l3.
Proof.
  intros.
  induction l1.
  - auto.
  - simpl.
    rewrite <- IHl1.
    auto.
Qed.

Lemma rev_app_distr : forall l1 l2 : natlist,
  rev (l1 ++ l2) = rev l2 ++ rev l1.
Proof.
  intros.
  induction l1.
  - simpl.
    rewrite -> app_nil_r.
    auto.
  - simpl.
    rewrite -> IHl1.
    rewrite <- app_assoc.
    auto.
Qed.

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

(* Lemma app_assoc4: forall l1 l2 l3 l4 : natlist,
  l1 ++ (l2 ++ (l3 ++ l4)) = (l1 ++ (l2 ++ l3)) ++ l4.
Proof.
  intros.
  induction l1.
  - rewrite -> app_assoc.
    simpl.
    rewrite -> app_assoc.
    auto.
  - simpl.
    rewrite -> IHl1.
    auto.
Qed. *)

Lemma app_assoc4 : forall l1 l2 l3 l4 : natlist,
  l1 ++ (l2 ++ (l3 ++ l4)) = (l1 ++ (l2 ++ l3)) ++ l4.
Proof.
  intros.
  rewrite 3 app_assoc.
  auto.
Qed.

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

Fixpoint beq_natlist (l1 l2 : natlist) :=
  match l1 with
  | nil => match l2 with
           | nil => true
           | x :: s => false
          end
  | x :: s => match l2 with
            | nil => false
            | y :: t => if beq_n x y then beq_natlist s t
                                    else false
          end
  end.

Compute (beq_natlist [1;2;3] [1;2;4]).

Lemma beq_natlist_refl : forall l : natlist,
  beq_natlist l l = true.
Proof.
  intros.
  induction l.
  - auto.
  - simpl.
    rewrite -> beq_n_refl.
    trivial.
Qed.

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

Lemma count_member_nonzero :
  forall (s : bag), leb 1 (count 1 (1 :: s)) = true.
Proof.
  intros.
  induction s.
  - auto.
  - trivial.
Qed.

Lemma ble_n_Sn : forall n : nat,
  leb n (S n) = true.
Proof.
  intros.
  induction n.
  - auto.
  - simpl. rewrite -> IHn.
    auto.
Qed.

Lemma remove_does_not_increase_count :
  forall (s : bag), leb (count 0 (remove_one 0 s)) (count 0 s) = true.
Proof.
  intros.
  induction s.
  - auto.
  - destruct n.
    + simpl. rewrite -> ble_n_Sn.
      auto.
    + simpl.
      trivial.
Qed.

Lemma rev_app : forall (n : nat) (l : natlist),
  rev (n :: l) = rev l ++ [n].
Proof.
  intros.
  induction l.
  - auto.
  - auto.
Qed.

Check f_equal.

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

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

Definition hd_error (l : natlist) :=
  match l with
  | nil => None
  | x :: s => Some x
  end.

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

Lemma option_elim_hd : forall (l : natlist) (d : nat),
  hd d l = option_elim (hd_error l) d.
Proof.
  intros.
  induction l.
  - auto.
  - auto.
Qed.

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

Definition beq_id (a b : id) :=
  match a,b with
  | Id a', Id b' => beq_n a' b'
  end.

Lemma beq_id_refl : forall x : id, beq_id x x = true.
Proof.
  intros.
  destruct x.
  - simpl.
    apply beq_n_refl.
Qed.

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

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

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

Lemma update_eq : forall (d : partial_map) (x : id) (o : nat),
  find x (update d x o) = Some o.
Proof.
  intros.
  simpl.
  rewrite -> beq_id_refl.
  auto.
Qed.

Lemma 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.
  simpl.
  rewrite -> H.
  auto.
Qed.

Inductive baz : Type :=
  | Baz1 : baz -> baz
  | Baz2 : baz -> bool -> baz.

Definition bazp (b : baz) := Baz2 b true.

Definition baz_elim (b : baz) :=
  match b with
  | Baz1 b' => b'
  | Baz2 b' _ => b'
  end.

Lemma baz_exp : forall b : baz, baz_elim (bazp b) = b.
Proof.
  intros.
  destruct b.
  - auto.
  - auto.
Qed.


Definition le (x y : nat) : Prop :=
  exists k, x + k = y.

Notation "x <= y" := (le x y).
Notation "x < y" := (le (S x) y).

Definition dec (X : Prop) :=
  {X} + {~ X}.

Lemma origin x :
  0 <= x.
Proof.
  exists x. reflexivity.
Qed.

Lemma refl x :
  x <= x.
Proof.
  exists 0. lia.
Qed.

Lemma trans x y z :
  x <= y -> y <= z -> x <= z.
Proof.
  intros [k <-] [l <-].
  exists (k + l). lia.
Qed.

Lemma antisym x y :
  x <= y -> y <= x -> x = y.
Proof.
  intros [k Hk] [l Hl]. lia.
Qed.

Lemma shift x y :
  S x <= S y <-> x <= y.
Proof.
  split; intros [k Hk].
  - exists k. lia.
  - exists k. lia.
Qed.

Lemma strict x :
  ~ x < x.
Proof.
  intros [k Hk]. lia.
Qed.

Lemma minimum x :
  ~ x < 0.
Proof.
  intros [k Hk]. lia.
Qed.

(*** Exercise 9.2 ***)

Lemma add_sub_eq x y :
  x + y - x = y.
Proof.
  induction x as [|x IH]; cbn.
  - destruct y; reflexivity.
  - exact IH.
Qed.

Lemma le_add_sub x y :
  x <= y -> x + (y - x) = y.
Proof.
  intros [k <-]. rewrite add_sub_eq. reflexivity.
Qed.

(*** Exercise 9.3 ***)

Lemma linearity :
  forall n m, n <= m \/ m <= n.
Proof.
 induction n; destruct m.
 - left. exists 0. reflexivity.
 - left. exists (S m). reflexivity.
 - right. exists (S n). reflexivity.
 - destruct (IHn m) as [[k H]|[k H]].
   + left. exists k. lia.
   + right. exists k. lia.
Qed.

Lemma trichotomy :
  forall n m, n < m \/ n = m \/ m < n.
Proof.
 induction n; destruct m.
 - right. left. reflexivity.
 - left. exists m. reflexivity.
 - right. right. exists n. reflexivity.
 - destruct (IHn m) as [[k H]|[H|[k H]]].
   + left. exists k. lia.
   + right. left. congruence.
   + right. right. exists k. lia.
Qed.

(* The stronger statements using + have (almost) the same proof scripts
   and of course imply the weaker statements using ∨. *)

Lemma linearity_sum :
  forall n m, {n <= m} + {m <= n}.
Proof.
 induction n; destruct m.
 - left. exists 0. reflexivity.
 - left. exists (S m). reflexivity.
 - right. exists (S n). reflexivity.
 - destruct (IHn m) as [H|H].
   + left. destruct H as [k H]. exists k. lia.
   + right. destruct H as [k H]. exists k. lia.
Qed.

Lemma trichotomy_sum :
  forall n m, {n < m} + {n = m} + {m < n}.
Proof.
 induction n; destruct m.
 - left. right. reflexivity.
 - left. left. exists m. reflexivity.
 - right. exists n. reflexivity.
 - destruct (IHn m) as [[H|H]|H].
   + left. left. destruct H as [k H]. exists k. lia.
   + left. right. congruence.
   + right. destruct H as [k H]. exists k. lia.
Qed.

Lemma not_lt_le x y :
  ~ (y < x) -> x <= y.
Proof.
  intros HX. destruct (trichotomy x y) as [H|[H|H]]; trivial.
  - destruct H as [k <-]. exists (S k). lia.
  - subst. apply refl.
  - contradiction.
Qed.

Lemma not_lt_eq x y :
  ~ (x < y) -> ~ (y < x) -> x = y.
Proof.
  intros H1 H2. apply antisym; now apply not_lt_le.
Qed.

(*** Exercise 9.4 ***)

Lemma le_iff x y :
  x <= y <-> x - y = 0.
Proof.
  split.
  - intros [k <-]. lia.
  - intros H. exists (y - x). lia.
Qed.

Lemma le_dec x y :
  dec (x <= y).
Proof.
  destruct (x - y) eqn : H.
  - left. now apply le_iff.
  - right. intros H' % le_iff.
    congruence.
Qed.

Lemma le_dec' x y :
  dec (x <= y).
Proof.
  revert y. induction x; intros [].
  - left. apply origin.
  - left. apply origin.
  - right. apply minimum.
  - destruct (IHx n) as [H|H].
    + left. now apply shift.
    + right. intros H'. now apply H, shift.
Qed.

Fixpoint le_bool (x y : nat) : bool :=
  match x, y with
  | 0, y => true
  | S x, 0 => false
  | S x, S y => le_bool x y
  end.

Lemma le_bool_spec x y :
  x <= y <-> le_bool x y = true.
Proof.
  revert y. induction x; intros []; cbn.
  - split; trivial. intros _. apply refl.
  - split; trivial. intros _. apply origin.
  - split; try congruence. now intros H % minimum.
  - (* propositional equivalences can be used for rewriting: *)
    rewrite shift. apply IHx.
Qed.

(*** Exercise 9.5 ***)

Lemma nat_dec (x y : nat) :
  dec (x = y).
Proof.
  destruct (trichotomy_sum x y) as [[H|H]|H].
  - right. intros ->. now apply strict in H.
  - now left.
  - right. intros ->. now apply strict in H.
Qed.

End LE.

Lemma le_lt_dec x y :
  {x <= y} + {y < x}.
Proof.
  induction x as [|x IH] in y |-*.
  - left. lia.
  - destruct y as [|y].
    + right. lia.
    + specialize (IH y) as [IH|IH].
      * left. lia.
      * right. lia.
Qed.

(*** Exercise 9.8 ***)

Definition divides x y :=
  x <> 0 /\ exists k, y = k * x.

Lemma divides_dec x y :
  dec (divides x y).
Proof.
 destruct x.
 - right. intros [H _]. now apply H.
 - destruct (M y x) eqn : H.
   + left. split; try congruence. exists (D y x).
     rewrite (DM_spec1 y x) at 1. lia.
   + right. intros [_ [k H']].
     destruct (div_mod_unique x (D y x) (M y x) k 0).
     * apply DM_spec2.
     * lia.
     * rewrite <- (DM_spec1 y x). lia.
     * congruence.
Qed.

Definition cong x y k :=
  (x <= y /\ divides k (y - x)) \/ (y < x /\ divides k (x - y)).

Lemma cong_dec x y k :
  dec (cong x y k).
Proof.
  destruct (le_lt_dec x y) as [H|H].
  - destruct (divides_dec k (y - x)) as [H'|H'].
    + left. left. now split.
    + right. intros [[H1 H2]|[H1 H2]]; auto. lia.
  - destruct (divides_dec k (x - y)) as [H'|H'].
    + left. right. now split.
    + right. intros [[H1 H2]|[H1 H2]]; auto. lia.
Qed.

(*** Exercise 9.10 ***)

Definition spec_exp mu :=
  forall f n, (f (mu f n) = true -> mu f n <= n /\ forall k, k < mu f n -> f k = false)
         /\ (f (mu f n) = false -> mu f n = n /\ forall k, k <= n -> f k = false).

Definition wf X (R : X -> X -> Prop) :=
  forall f, (exists x, f x = true) -> exists x, f x = true /\ forall y, f y = true -> R x y.

Lemma nat_wf mu :
  spec_exp mu -> wf nat (fun x y => x <= y).
Proof.
  intros HM f [n Hn]. exists (mu f n). destruct (f (mu f n)) eqn : H.
  - split; trivial. intros n' Hn'. apply HM in H.
    destruct (le_lt_dec (mu f n) n'); trivial.
    apply H in l. congruence.
  - exfalso. apply HM in H as [_ H].
    assert (H' : n <= n) by lia.
    specialize (H n H'). congruence.
Qed.

(*** Exercise 9.11 ***)

Section S1.
  Variables (f: nat -> bool)
            (mu: nat -> nat)
            (R1: mu 0 = 0)
            (R2: forall n, mu (S n) = if f (mu n) then mu n else S n).

  Goal forall n, if f (mu n)
            then mu n <= n /\ forall k, k < mu n -> f k = false
            else mu n = n /\ forall k, k <= n -> f k = false.
  Proof.
    induction n as [|n IH].
    - rewrite R1. destruct (f 0) eqn:H1.
      + intuition. lia.
      + intuition. assert (k=0) as -> by lia. exact H1.
    - rewrite R2. destruct (f (mu n)) eqn:H1.
      + rewrite H1. intuition.
      + destruct (f (S n)) eqn:H2.
        * intuition.
        * intuition.
          assert (k = S n \/ k <= n) as [->|H4] by lia; auto.
  Qed.

  Variables (mu': nat -> nat)
            (R1': mu' 0 = 0)
            (R2': forall n, mu' (S n) = if f (mu' n) then mu' n else S n).

  Goal forall n, mu n = mu' n.
  Proof.
    induction n as [|n IH].
    - congruence.
    - rewrite R2, R2'. rewrite <-IH. reflexivity.
  Qed.
End S1.

Section S2.
  Variables (f: nat -> bool) (mu: nat -> nat).
  Variable (R: forall n, if f (mu n)
                    then mu n <= n /\ forall k, k < mu n -> f k = false
                    else mu n = n /\ forall k, k <= n -> f k = false ).

  Goal forall n, mu n <= n.
  Proof.
    intros *. generalize (R n). destruct (f (mu n)) eqn:H1; lia.
  Qed.

  Goal forall n k, k < mu n -> f k = false.
  Proof.
    intros *. generalize (R n).
    destruct (f (mu n)) eqn:H1; intuition.
  Qed.

  Goal forall n, mu n < n -> f (mu n) = true.
  Proof.
     intros *. generalize (R n).
     destruct (f (mu n)) eqn:H1; intuition.
  Qed.
End S2.

Section S3.
  Variables (f: nat -> bool) (mu: nat -> nat).
  Variables (R1: forall n, mu n <= n)
            (R2: forall n k, k < mu n -> f k = false)
            (R3: forall n, mu n < n -> f (mu n) = true).

  Lemma L1 n :
    ~ mu n < n -> mu n = n.
  Proof.
    specialize (R1 n). lia.
  Qed.

  Goal mu 0 = 0.
  Proof.
    generalize (R1 0). lia.
  Qed.

  Lemma not_lt_eq' x y :
    ~ x < y -> ~ y < x -> x = y.
  Proof.
    intros H1 H2. lia.
  Qed.

  Goal forall n, mu (S n) = if f (mu n) then mu n else S n.
  Proof.
    intros n. destruct (f (mu n)) eqn:H1.
    - apply not_lt_eq'; intros H2.
      + assert (H3: f (mu (S n)) = false) by eapply R2, H2.
        enough (f (mu (S n)) = true) by congruence.
        apply R3. specialize (R1 n). lia.
      + apply R2 in H2. congruence.
    - assert (H2: mu n = n).
      { apply L1. intros H2%R3. congruence. }
      apply L1. intros H3.
      assert (H4: f (mu (S n)) = true) by apply R3, H3.
      assert (mu (S n) = n \/ mu (S n) < mu n) as [H5|H5] by lia.
      + congruence.
      + apply R2 in H5. congruence.
  Qed.
End S3.

(*** Exercise 9.12 ***)

Section Challenge.

  Variable D M : nat -> nat -> nat.
  Hypothesis DM1 : forall x y, x = D x y * S y + M x y.
  Hypothesis DM2 : forall x y, M x y <= y.

  Goal forall x y, y < x -> D x y = S (D (x - S y) y).
  Proof.
    intros x y H. apply (div_mod_unique y (D x y) (M x y) (S (D (x - S y) y)) (M (x - S y) y)).
    - apply DM2.
    - apply DM2.
    - generalize (DM1 x y) (DM1 (x - S y) y). lia.
  Qed.

  Goal forall x y, x <= y -> D x y = 0.
  Proof.
    intros x y H. apply (div_mod_unique y (D x y) (M x y) 0 x).
    - apply DM2.
    - apply H.
    - cbn. symmetry. apply DM1.
  Qed.

End Challenge.

(*** Exercise 9.6 ***)

(* We now switch to the pre-defined x <= y and fully rely on lia. *)

Lemma size_induction X (f : X -> nat) (p : X -> Type) :
  (forall x, (forall y, f y < f x -> p y) -> p x) -> forall x, p x.
Proof.
  intros H x. apply H.
  enough (G : forall n y, f y < n -> p y) by apply G.
  intros n. induction n; intros y Hy.
  - exfalso. lia.
  - apply H. intros z HZ. apply IHn. lia.
Qed.

Lemma complete_induction (p : nat -> Type) :
  (forall x, (forall y, y < x -> p y) -> p x) -> forall x, p x.
Proof.
  apply (size_induction nat (fun n => n)).
Qed.

(*** Exercise 9.7 ***)

Lemma div_mod_unique y a b a' b' :
  b <= y -> b' <= y -> a * S y + b = a' * S y + b' -> a = a' /\ b = b'.
Proof.
  intros H1 H2.
  (* the pattern "in a' |-*" generalises a' in the induction *)
  induction a as [|a IH] in a' |-*; destruct a'; cbn.
  - tauto.
  - intros ->. exfalso. lia.
  - intros <-. exfalso. lia.
  - (* the = in the intro pattern applies injectivity *)
    intros [= H3]. destruct (IH a') as [-> ->]; lia.
Qed.

Theorem div_mod x y :
  { a & { b & x = a * S y + b /\ b <= y}}.
Proof.
  induction x as [x IH] using complete_induction.
  destruct (le_lt_dec x y) as [H|H].
  - exists 0, x. split; trivial.
  - destruct (IH (x - S y)) as (a&b&H2&H3).
    + lia.
    + exists (S a), b. lia.
Qed.

Definition D (x y : nat) := projT1 (div_mod x y).
Definition M (x y : nat) := projT1 (projT2 (div_mod x y)).

Lemma DM_spec1 x y :
  x = D x y * S y + M x y.
Proof.
  apply (projT2 (projT2 (div_mod x y))).
Qed.

Lemma DM_spec2 x y :
  M x y <= y.
Proof.
  apply (projT2 (projT2 (div_mod x y))).
Qed.


From mathcomp Require Import ssreflect ssrbool eqtype ssrnat seq.

(* In this section, we define some properties of relations
   that are important for fixed-point iterations. *)
Section Relations.

  Context {T: Type}.
  Variable R: rel T.
  Variable f: T -> T.

  Definition monotone (R: rel T) :=
    forall x y, R x y -> R (f x) (f y).

End Relations.

Section Order.

  Context {T: eqType}.
  Variable rel: T -> T -> bool.
  Variable l: seq T.

  Definition total_over_list :=
    forall x1 x2,
      x1 \in l ->
      x2 \in l ->
      (rel x1 x2 \/ rel x2 x1).

  Definition antisymmetric_over_list :=
    forall x1 x2,
      x1 \in l ->
      x2 \in l ->
      rel x1 x2 ->
      rel x2 x1 ->
      x1 = x2.

End Order.


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

Require Import Arith Max Omega List Permutation.

Require Import list_in.

Set Implicit Arguments.

Fact In_map_nat_find X (f : X -> nat) x l : In x (map f l) -> { u | x = f u /\ In u l }.
Proof.
  induction l as [ | y l IH ].
  intros [].
  destruct (eq_nat_dec x (f y)) as [ | C ].
  exists y; split; auto; left; auto.
  intros H.
  destruct IH as (u & H1 & H2).
  destruct H; auto; contradict C; auto.
  exists u; split; auto; right; auto.
Qed.

Notation lsum := (fold_right plus 0).

Fact lsum_prop x ll : In x ll -> x <= lsum ll.
Proof.
  induction ll as [ | y ll IH ]; simpl.
  intros [].
  intros [ | H ]; subst.
  omega.
  specialize (IH H); omega.
Qed.

Fact lsum_perm l m : Permutation l m -> lsum l = lsum m.
Proof.
  induction 1; simpl; auto; omega.
Qed.

Fact lsum_app l r : lsum (l++r) = lsum l + lsum r.
Proof.
  induction l; simpl; auto; omega.
Qed.

Section lmax.

  Definition lmax := fold_right max 0.

  Fact lmax_fix x l : lmax (x::l) = max x (lmax l).
  Proof. auto. Qed.

  Fact Forall2_lmax ll mm : Forall2 le ll mm -> lmax ll <= lmax mm.
  Proof.
    induction 1; auto.
    do 2 rewrite lmax_fix.
    apply max_lub.
    apply le_trans with (2 := le_max_l _ _); auto.
    apply le_trans with (2 := le_max_r _ _); auto.
  Qed.

  Fact lmax_In x ll : In x ll -> x <= lmax ll.
  Proof.
    induction ll as [ | y ll IH ].
    simpl; omega.
    rewrite lmax_fix.
    intros [ H | H ]; subst.
    apply le_max_l.
    apply le_trans with (1 := IH H), le_max_r.
  Qed.

  Fact lmax_inv l : { l = nil } + { In (lmax l) l }.
  Proof.
    induction l as [ | x l IHl ].
    left; auto.
    right.
    simpl.
    destruct IHl.
    subst; left; simpl.
    rewrite max_0_r; auto.
    destruct (le_lt_dec x (lmax l)).
    right; rewrite max_r; auto.
    left; rewrite max_l; auto.
    apply lt_le_weak; assumption.
  Qed.

  Fact lmax_inv' l : 0 < lmax l -> { x | In x l /\ x = lmax l }.
  Proof.
    intros H0; destruct (lmax_inv l) as [ H | H ].
    exfalso; subst; simpl in H0; omega.
    exists (lmax l); auto.
  Qed.

  Fact lmax_map_inv X (f : X -> nat) l : l <> nil -> { x | In x l /\ f x = lmax (map f l) }.
  Proof.
    intros H0.
    destruct (lmax_inv (map f l)) as [ H | H ].
    contradict H0.
    destruct l; auto; discriminate H.
    apply In_map_nat_find in H.
    destruct H as (u & ? & ?); exists u; auto.
  Qed.

  Fact lmax_inv_t l : 0 < lmax l -> { x : _ & { _ : In_t x l | x = lmax l } }.
  Proof.
    induction l as [ | x l IH ].
    simpl; omega.
    intros H0.
    destruct (eq_nat_dec (lmax l) 0) as [ H1 | H1 ].

    rewrite lmax_fix, H1, max_0_r in H0.
    exists x; split; simpl; auto.
    rewrite H1, max_0_r; auto.

    destruct IH as (z & H2 & H3).
    omega.
    destruct (le_lt_dec x z) as [ H4 | H4 ].
    exists z; split; simpl; auto.
    rewrite max_r; omega.
    exists x; split; simpl; auto.
    rewrite max_l; omega.
  Qed.

  Fact lmax_0_inv l : lmax l = 0 -> (In_t 0 l + { l = nil })%type.
  Proof.
    destruct l as [ | x l ].
    right; auto.
    rewrite lmax_fix.
    intros H.
    destruct (max_dec x (lmax l)) as [ E | E ];
    rewrite H in E.
    subst x; left; left; auto.
    rewrite <- E, max_0_r in H.
    subst x; left; left; auto.
  Qed.

  Fact lmax_app l m : lmax (l++m) = max (lmax l) (lmax m).
  Proof.
    induction l as [ | x l IH ]; simpl; auto.
    rewrite IH; apply max_assoc.
  Qed.

  Variable (f : nat -> nat) (Hf : forall m n, m <= n -> f m <= f n).

  Fact max_monotone n m : f (max n m) = max (f n) (f m).
  Proof.
    symmetry; destruct (max_dec n m) as [ H | H ]; rewrite H.
    apply max_l, Hf; rewrite <- H; apply le_max_r.
    apply max_r, Hf; rewrite <- H; apply le_max_l.
  Qed.

  Fact lmax_mono l : l <> nil -> lmax (map f l) = f (lmax l).
  Proof.
    induction l as [ | x [ | y l ] IH ]; simpl.
    intros H; contradict H; auto.
    do 2 rewrite max_0_r; auto.
    intros _; rewrite max_monotone; f_equal.
    apply IH; discriminate.
  Qed.

End lmax.

Fixpoint list_n n := match n with 0 => nil | S n => n::list_n n end.

Fact list_n_prop n x : x < n <-> In x (list_n n).
Proof.
  revert x; induction n as [ | ? IH ]; intros ?.
  split.
  omega.
  intros [].
  simpl; rewrite <- IH.
  split; omega.
Qed.

Fact list_n_length x : length (list_n x) = x.
Proof. induction x; simpl; f_equal; auto. Qed.

Fact largest_nat_prefix n (P : nat -> Prop) : (forall i, i <= n -> { P i } + { ~ P i })
                                           -> P 0
                                           -> { i | i <= n
                                                 /\ P i
                                                 /\ (P (S i) -> n <= i)
                                                 /\ forall j, j <= i -> P j }.
Proof.
  revert P.
  induction n as [ | n IHn ]; intros P HP H.

  exists 0.
  repeat split; auto.
  intros j Hj.
  cutrewrite (j = 0); auto; omega.

  destruct (HP 1) as [ H1 | H1 ]; try omega.

  destruct (IHn (fun x => P (S x))) as (i & H3 & H4 & H5 & H6); auto.
  intros; apply  HP; omega.
  exists (S i); repeat split; auto.
  omega.
  intros H'; apply H5 in H'; omega.
  intros [ | j ]; auto.
  intros H7; apply H6; omega.

  exists 0; repeat split; auto.
  omega.
  tauto.
  intros j Hj; cutrewrite (j=0); auto; omega.
Qed.


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

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

Compute (next_weekday friday).

Compute (next_weekday (next_weekday saturday)).

Example test_next_weekday:
  (next_weekday (next_weekday saturday)) = tuesday.

Proof. simpl. reflexivity. Qed.

Inductive bool : Type := true | false.

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

Definition andb (b_1:bool) (b_2:bool) : bool :=
  match b_1 with
  | true => b_2
  | false => false
  end.

Definition orb (b_1:bool) (b_2:bool) : bool :=
  match b_1 with
  | true => true
  | false => b_2
  end.

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

Notation "x && y" := (andb x y).
Notation "x || y" := (orb x y).

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

Definition nandb (b_1:bool) (b_2:bool) : bool :=
  negb (andb b_1 b_2).

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

Definition andb3 (b_1:bool) (b_2:bool) (b_3:bool) : bool :=
  b_1 && b_2 && b_3.

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

Inductive rgb : Type :=
  | red
  | green
  | blue.

Inductive color : Type :=
  | black
  | white
  | primary (p:rgb).

Definition monochrome (c:color) : bool :=
  match c with
  | black => true
  | white => true
  | primary q => false
  end.

Definition isred (c:color) : bool :=
  match c with
  | black => false
  | white => false
  | primary red => true
  | primary _ => false
  end.

Inductive bit : Type := B0 | B1.

Inductive nybble : Type :=
  | bits ( b0 b1 b2 b3 : bit ).

Check (bits B1 B0 B1 B0).

Definition all_zero (nb : nybble) : bool :=
  match nb with
  | (bits B0 B0 B0 B0) => true
  | (bits _ _ _ _) => false
  end.

Compute all_zero (bits B1 B0 B1 B0).
Compute all_zero (bits B0 B0 B0 B0).

Module NatPlayground.
  Inductive nat : Type :=
    | O
    | S (n : nat).

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

Check (S (S (S (S O)))).

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

Compute minustwo 4.

Check S.
Check pred.
Check minustwo.

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

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

Example test_oddb1: oddb 1 = true.
Proof. simpl. reflexivity. Qed.
Example test_oddb2: oddb 4 = false.
Proof. simpl. reflexivity. Qed.

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

  Compute plus 3 2.

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

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

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

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

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

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

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

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

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

Example test_leb1: (leb 2 2) = true.
Proof. simpl. reflexivity. Qed.
Example test_leb2: (leb 2 4) = true.
Proof. simpl. reflexivity. Qed.
Example test_leb3: (leb 4 2) = false.
Proof. simpl. reflexivity. Qed.

Notation "x =? y" := (eqb x y) (at level 70) : nat_scope.
Notation "x <=? y" := (leb x y) (at level 70) : nat_scope.
Example test_leb3': (4 <=? 2) = false.
Proof. simpl. reflexivity. Qed.

Definition ltb (n m : nat) : bool :=
  match n, m with
  | _, O => false
  | O, _ => true
  | S _, S m' => leb n m'
  end.

Example test_ltb1: ltb 2 2 = false.
Proof. simpl. reflexivity. Qed.
Example test_ltb2: ltb 2 4 = true.
Proof. simpl. reflexivity. Qed.
Example test_ltb3: ltb 4 2 = false.
Proof. simpl. reflexivity. Qed.

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

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

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

Theorem plus_id_example: forall n m : nat,
  n = m ->
  n + n = m + m.

Proof.
  (* move both quantifiers into ctx *)
  intros n m.
  (* move hypothesis into ctx *)
  intros H.
  (* rewrite goal using hypothesis *)
  rewrite -> H.
  reflexivity.
Qed.

Theorem plus_id_exercise : forall n m o : nat,
  n = m -> m = o -> n + m = m + o.

Proof.
  intros n m o.
  intros H I.
  rewrite -> H.
  rewrite -> I.
  reflexivity.
Qed.

Theorem mult_0_plus: forall n m : nat,
  (0 + n) * m = n * m.

Proof.
  intros n m.
  rewrite -> plus_O_n.
  reflexivity.
Qed.

Theorem mult_S_l: forall n m : nat,
  m = S n ->
  m * (1 + n) = m * m.

Proof.
  intros n m.
  intros H.
  rewrite -> plus_1_l.
  rewrite -> H.
  reflexivity.
Qed.

Theorem plus_1_neq_0_firsttry: forall n : nat,
  (n + 1) =? 0 = false.

Proof.
  intros n.
  simpl.
Abort.

Theorem plus_1_neq_0: forall n : nat,
  (n + 1) =? 0 = false.

Proof.
  intros n.
  destruct n as [| n'] eqn:E.
  - reflexivity.
  - reflexivity.
Qed.

Theorem negb_involutive: forall b : bool,
  negb (negb b) = b.

Proof.
  intros b.
  destruct b eqn:E.
  - reflexivity.
  - reflexivity.
Qed.

Theorem andb_commutative: forall b c,
  andb b c = andb c b.

Proof.
  intros b c.
  destruct b eqn:Eb.
  - destruct c eqn:Ec.
    + reflexivity.
    + reflexivity.
  - destruct c eqn:Ec.
    + reflexivity.
    + reflexivity.
Qed.

Theorem andb3_exchange: forall b c d,
  andb (andb b c) d = andb (andb b d) c.

Proof.
  intros b c d.
  destruct b eqn:Eb.
  - destruct c eqn:Ec.
    { destruct d eqn:Ed.
      - reflexivity.
      - reflexivity. }
    { destruct d eqn:Ed.
      - reflexivity.
      - reflexivity. }
  - destruct c eqn:Ec.
    { destruct d eqn:Ed.
      - reflexivity.
      - reflexivity. }
    { destruct d eqn:Ed.
      - reflexivity.
      - reflexivity. }
Qed.

Theorem plus_1_neq_0': forall n : nat,
  (n + 1) =? 0 = false.

Proof.
  intros [|n].
  - reflexivity.
  - reflexivity.
Qed.

Theorem andb_commutative'': forall b c,
  andb b c = andb c b.

Proof.
  intros [] [].
  - reflexivity.
  - reflexivity.
  - reflexivity.
  - reflexivity.
Qed.

Theorem andb_true_elim2: forall b c : bool,
  andb b c = true -> c = true.

Proof.
  intros [] [] H.
  - reflexivity.
  - rewrite <- H.
    reflexivity.
  - reflexivity.
  - rewrite <- H.
    reflexivity.
Qed.

Theorem zero_nbeq_plus_1: forall n : nat,
  0 =? (n + 1) = false.

Proof.
  intros [| n'].
  - reflexivity.
  - reflexivity.
Qed.