(** * D4: Arytmetyka Peano *)

(* begin hide *)

(*
TODO: opisać silnię, współczynniki dwumianowe, sumy szeregów
TODO: opisać charakteryzowanie wzorów rekurencyjnych
*)

(* end hide *)

(** Poniższe zadania mają służyć utrwaleniu zdobytej dotychczas wiedzy na
    temat prostej rekursji i indukcji. Większość powinna być robialna po
    przeczytaniu rozdziału o konstruktorach rekurencyjnych, ale niczego nie
    gwarantuję.

    Celem zadań jest rozwinięcie arytmetyki do takiego poziomu, żeby można
    było tego używać gdzie indziej w jakotakim stopniu. Niektóre zadania
    mogą pokrywać się z zadaniami obecnymi w tekście, a niektóre być może
    nawet z przykładami. Staraj się nie podglądać.

    Nazwy twierdzeń nie muszą pokrywać się z tymi z biblioteki standardowej,
    choć starałem się, żeby tak było. *)

Require Import Recdef.
Require Import Setoid.

Require Div2 ZArith.

Module MyNat.

(** * Podstawy *)

(** ** Definicja i notacje *)

(** Zdefiniuj liczby naturalne. *)

(* begin hide *)
Inductive nat : Set :=
| O : nat
| S : nat -> nat.
(* end hide *)

Notation "0" := O.
Notation "1" := (S 0).
Notation "2" := (S (S 0)).

(** ** [0] i [S] *)

(** Udowodnij właściwości zera i następnika. *)

Lemma neq_0_Sn :
  forall n : nat, 0 <> S n.
(* begin hide *)
Proof.
  do 2 intro. inversion H.
Qed.
(* end hide *)

Lemma neq_n_Sn :
  forall n : nat, n <> S n.
(* begin hide *)
Proof.
  induction n as [| n'].
    apply neq_0_Sn.
    intro. apply IHn'. inversion H. assumption.
Qed.
(* end hide *)

Lemma not_eq_S :
  forall n m : nat, n <> m -> S n <> S m.
(* begin hide *)
Proof.
  intros; intro. apply H. inversion H0. trivial.
Qed.
(* end hide *)

Lemma S_injective :
  forall n m : nat, S n = S m -> n = m.
(* begin hide *)
Proof.
  inversion 1. trivial.
Qed.
(* end hide *)

(** ** Poprzednik *)

(** Zdefiniuj funkcję zwracającą poprzednik danej liczby naturalnej.
    Poprzednikiem [0] jest [0]. *)

(* begin hide *)
Definition pred (n : nat) : nat :=
match n with
| 0 => 0
| S n' => n'
end.
(* end hide *)

Lemma pred_0 : pred 0 = 0.
(* begin hide *)
Proof.
  trivial.
Qed.
(* end hide *)

Lemma pred_S :
  forall n : nat, pred (S n) = n.
(* begin hide *)
Proof.
  trivial.
Qed.
(* end hide *)

(** * Proste działania *)

(** ** Dodawanie *)

(** Zdefiniuj dodawanie (rekurencyjnie po pierwszym argumencie) i
    udowodnij jego właściwości. *)

(* begin hide *)
Fixpoint add (n m : nat) : nat :=
match n with
| 0 => m
| S n' => S (add n' m)
end.
(* end hide *)

Lemma add_0_l :
  forall n : nat, add 0 n = n.
(* begin hide *)
Proof.
  intro. cbn. trivial.
Qed.
(* end hide *)

Lemma add_0_r :
  forall n : nat, add n 0 = n.
(* begin hide *)
Proof.
  intro. induction n as [| n'].
    trivial.
    cbn. f_equal. assumption.
Qed.
(* end hide *)

Lemma add_S_l :
  forall n m : nat, add (S n) m = S (add n m).
(* begin hide *)
Proof.
  induction n as [| n']; cbn; trivial.
Qed.
(* end hide *)

Lemma add_S_r :
  forall n m : nat, add n (S m) = S (add n m).
(* begin hide *)
Proof.
  induction n as [| n']; cbn; intro.
    trivial.
    rewrite IHn'. trivial.
Qed.
(* end hide *)

Lemma add_assoc :
  forall a b c : nat,
    add a (add b c) = add (add a b) c.
(* begin hide *)
Proof.
  induction a as [| a']; cbn.
    trivial.
    intros. rewrite IHa'. trivial.
Qed.
(* end hide *)

Lemma add_comm :
  forall n m : nat, add n m = add m n.
(* begin hide *)
Proof.
  induction n as [| n']; cbn; intros.
    rewrite add_0_r. trivial.
    induction m as [| m']; cbn.
      rewrite add_0_r. trivial.
      rewrite IHn'. rewrite <- IHm'. cbn. rewrite IHn'.
        trivial.
Qed.
(* end hide *)

Lemma add_no_absorbing_l :
  ~ exists a : nat, forall n : nat, add a n = a.
(* begin hide *)
Proof.
  intro. destruct H as [a H]. specialize (H (S 0)).
  rewrite add_comm in H. cbn in H. induction a as [| a'].
    inversion H.
    apply IHa'. inversion H. assumption.
Qed.
(* end hide *)

Lemma add_no_absorbing_r :
  ~ exists a : nat, forall n : nat, add n a = a.
(* begin hide *)
Proof.
  intro. destruct H as [a H]. specialize (H (S 0)).
  rewrite add_comm in H. cbn in H. induction a as [| a'].
    inversion H.
    apply IHa'. rewrite add_comm in *. cbn in *.
      inversion H. assumption.
Qed.
(* end hide *)

Lemma add_no_inverse_l :
  ~ forall n : nat, exists i : nat, add i n = 0.
(* begin hide *)
Proof.
  intro. destruct (H (S 0)) as [i H']. rewrite add_comm in H'.
  inversion H'.
Qed.
(* end hide *)

Lemma add_no_inverse_r :
  ~ forall n : nat, exists i : nat, add n i = 0.
(* begin hide *)
Proof.
  intro. destruct (H (S 0)) as [i H']. inversion H'.
Qed.
(* end hide *)

Lemma add_no_inverse_l_strong :
  forall n i : nat, n <> 0 -> add i n <> 0.
(* begin hide *)
Proof.
  destruct i; cbn; intros.
    assumption.
    inversion 1.
Qed.
(* end hide *)

Lemma add_no_inverse_r_strong :
  forall n i : nat, n <> 0 -> add n i <> 0.
(* begin hide *)
Proof.
  intros. rewrite add_comm. apply add_no_inverse_l_strong. assumption.
Qed.
(* end hide *)

(** ** Alternatywne definicje dodawania *)

(** Udowodnij, że poniższe alternatywne metody zdefiniowania dodawania
    rzeczywiście definiują dodawanie. *)

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

Lemma add'_is_add :
  forall n m : nat, add' n m = add n m.
(* begin hide *)
Proof.
  intros n m. generalize dependent n.
  induction m as [| m']; cbn; intros.
    rewrite add_0_r. trivial.
    rewrite IHm'. rewrite (add_comm n (S m')). cbn.
      rewrite add_comm. trivial.
Qed.
(* end hide *)

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

Lemma add''_is_add :
  forall n m : nat, add'' n m = add n m.
(* begin hide *)
Proof.
  induction n as [| n']; cbn.
    reflexivity.
    intro. rewrite IHn', add_comm. cbn. rewrite add_comm. reflexivity.
Qed.
(* end hide *)

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

Lemma add'''_is_add :
  forall n m : nat, add''' n m = add n m.
(* begin hide *)
Proof.
  intros n m. generalize dependent n.
  induction m as [| m']; cbn; intros.
    rewrite add_0_r. reflexivity.
    rewrite IHm'. cbn. rewrite (add_comm n (S _)). cbn.
      rewrite add_comm. reflexivity.
Qed.
(* end hide *)

(** ** Odejmowanie *)

(** Zdefiniuj odejmowanie i udowodnij jego właściwości. *)

(* begin hide *)
Fixpoint sub (n m : nat) : nat :=
match n, m with
| 0, _ => 0
| _, 0 => n
| S n', S m' => sub n' m'
end.
(* end hide *)

Lemma sub_1_r :
  forall n : nat, sub n 1 = pred n.
(* begin hide *)
Proof.
  repeat (destruct n; cbn; trivial).
Qed.
(* end hide *)

Lemma sub_0_l :
  forall n : nat, sub 0 n = 0.
(* begin hide *)
Proof.
  cbn. trivial.
Qed.
(* end hide *)

Lemma sub_0_r :
  forall n : nat, sub n 0 = n.
(* begin hide *)
Proof.
  destruct n; trivial.
Qed.
(* end hide *)

Lemma sub_S_S :
  forall n m : nat,
    sub (S n) (S m) = sub n m.
(* begin hide *)
Proof.
  cbn. trivial.
Qed.
(* end hide *)

Lemma sub_diag:
  forall n : nat, sub n n = 0.
(* begin hide *)
Proof.
  induction n as [| n']; cbn; trivial.
Qed.
(* end hide *)

Lemma sub_add_l :
  forall n m : nat,
    sub (add n m) n = m.
(* begin hide *)
Proof.
  induction n as [| n']; cbn.
    apply sub_0_r.
    apply IHn'.
Qed.
(* end hide *)

Lemma sub_add_l' :
  forall n m : nat,
    sub (add n m) m = n.
(* begin hide *)
Proof.
  intros. rewrite add_comm. apply sub_add_l.
Qed.
(* end hide *)

Lemma sub_add_r :
  forall a b c : nat,
    sub a (add b c) = sub (sub a b) c.
(* begin hide *)
Proof.
  induction a as [| a']; cbn; intros; [easy |].
  destruct b as [| b']; cbn.
  - now destruct c; cbn.
  - now rewrite IHa'.
Qed.
(* end hide *)

Lemma sub_exchange :
  forall a b c : nat,
    sub (sub a b) c = sub (sub a c) b.
(* begin hide *)
Proof.
  intros a b. generalize dependent a. induction b as [| b'].
    intros. repeat rewrite sub_0_r. trivial.
    intros a c. generalize dependent a. induction c as [| c'].
      intro. repeat rewrite sub_0_r. trivial.
      destruct a as [| a'].
        cbn. trivial.
        cbn in *. rewrite <- IHc'. rewrite IHb'. destruct a'; cbn.
          trivial.
          rewrite IHb'. trivial.
Restart.
  now intros; rewrite <- sub_add_r, add_comm, sub_add_r.
Qed.
(* end hide *)

Lemma sub_not_assoc :
  ~ forall a b c : nat,
      sub a (sub b c) = sub (sub a b) c.
(* begin hide *)
Proof.
  intro. specialize (H 1 1 1). cbn in H. inversion H.
Qed.
(* end hide *)

Lemma sub_not_comm :
  ~ forall n m : nat,
      sub n m = sub m n.
(* begin hide *)
Proof.
  intro. specialize (H 1 0). cbn in H. inversion H.
Qed.
(* end hide *)

Lemma sub_comm_char :
  forall n m : nat,
    sub n m = sub m n -> n = m.
(* begin hide *)
Proof.
  induction n as [| n']; intros [| m'] Heq; cbn in *; [easy | inversion Heq.. |].
  now f_equal; apply IHn'.
Qed.
(* end hide *)

(** ** Odejmowanie v2 *)

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

Lemma sub'_1_r :
  forall n : nat, sub' n 1 = pred n.
(* begin hide *)
Proof.
  reflexivity.
Qed.
(* end hide *)

Lemma sub'_pred_l :
  forall n m : nat,
    sub' (pred n) m = pred (sub' n m).
(* begin hide *)
Proof.
  induction m as [| m']; cbn.
    reflexivity.
    rewrite IHm'. reflexivity.
Qed.
(* end hide *)

Lemma sub'_0_l :
  forall n : nat,
    sub' 0 n = 0.
(* begin hide *)
Proof.
  induction n as [| n']; cbn.
    reflexivity.
    rewrite IHn'. cbn. reflexivity.
Qed.
(* end hide *)

Lemma sub'_0_r :
  forall n : nat,
    sub' n 0 = n.
(* begin hide *)
Proof.
  reflexivity.
Qed.
(* end hide *)

Lemma sub'_S_S :
  forall n m : nat,
    sub' (S n) (S m) = sub' n m.
(* begin hide *)
Proof.
  induction m as [| m']; cbn.
    reflexivity.
    rewrite <- IHm'. cbn. reflexivity.
Qed.
(* end hide *)

Lemma pred_sub'_S :
  forall n m : nat,
    pred (sub' (S n) m) = sub' n m.
(* begin hide *)
Proof.
  induction m as [| m']; cbn.
    reflexivity.
    rewrite IHm'. reflexivity.
Qed.

(* end hide *)
Lemma sub'_diag :
  forall n : nat,
    sub' n n = 0.
(* begin hide *)
Proof.
  induction n as [| n']; cbn.
    reflexivity.
    rewrite pred_sub'_S, IHn'. reflexivity.
Qed.
(* end hide *)

Lemma sub'_add_l :
  forall n m : nat,
    sub' (add n m) n = m.
(* begin hide *)
Proof.
  induction n as [| n']; cbn.
    reflexivity.
    intro. rewrite pred_sub'_S. apply IHn'.
Qed.
(* end hide *)

Lemma sub'_add_l' :
  forall n m : nat,
    sub' (add n m) m = n.
(* begin hide *)
Proof.
  intros. rewrite add_comm. apply sub'_add_l.
Qed.
(* end hide *)

Lemma sub'_add_r :
  forall a b c : nat,
    sub' a (add b c) = sub' (sub' a b) c.
(* begin hide *)
Proof.
  induction b as [| b']; cbn; intros.
    reflexivity.
    rewrite IHb', sub'_pred_l. reflexivity.
Qed.
(* end hide *)

Lemma sub'_exchange :
  forall a b c : nat,
    sub' (sub' a b) c = sub' (sub' a c) b.
(* begin hide *)
Proof.
  induction b as [| b']; cbn.
    reflexivity.
    intro. rewrite sub'_pred_l, IHb'. reflexivity.
Restart.
  now intros; rewrite <- sub'_add_r, add_comm, sub'_add_r.
Qed.
(* end hide *)

Lemma sub'_not_assoc :
  ~ forall a b c : nat,
      sub' a (sub' b c) = sub' (sub' a b) c.
(* begin hide *)
Proof.
  intro. specialize (H 1 1 1). cbn in H. inversion H.
Qed.
(* end hide *)

Lemma sub'_not_comm :
  ~ forall n m : nat,
      sub' n m = sub' m n.
(* begin hide *)
Proof.
  intro. specialize (H 1 0). cbn in H. inversion H.
Qed.
(* end hide *)

(** ** Mnożenie *)

(** Zdefiniuj mnożenie i udowodnij jego właściwości. *)

(* begin hide *)
Fixpoint mul (n m : nat) : nat :=
match n with
| 0 => 0
| S n' => add m (mul n' m)
end.
(* end hide *)

Lemma mul_0_l :
  forall n : nat,
    mul 0 n = 0.
(* begin hide *)
Proof.
  cbn. reflexivity.
Qed.
(* end hide *)

Lemma mul_0_r :
  forall n : nat,
    mul n 0 = 0.
(* begin hide *)
Proof.
  induction n as [| n']; cbn.
    reflexivity.
    assumption.
Restart.
  induction n; trivial.
Qed.
(* end hide *)

Lemma mul_1_l :
  forall n : nat,
    mul 1 n = n.
(* begin hide *)
Proof.
  destruct n as [| n'].
    cbn. trivial.
    cbn. rewrite add_0_r. trivial.
Restart.
  destruct n; cbn; try rewrite add_0_r; trivial.
Qed.
(* end hide*)

Lemma mul_1_r :
  forall n : nat,
    mul n 1 = n.
(* begin hide *)
Proof.
  induction n.
    cbn. trivial.
    cbn. rewrite IHn. trivial.
Restart.
  induction n; cbn; try rewrite IHn; trivial.
Qed.
(* end hide *)

Lemma mul_comm :
  forall n m : nat,
    mul n m = mul m n.
(* begin hide *)
Proof.
  induction n as [| n']; intro.
    rewrite mul_0_l, mul_0_r. trivial.
    induction m as [| m'].
      rewrite mul_0_l, mul_0_r. trivial.
      cbn in *. rewrite IHn', <- IHm', IHn'. cbn.
        do 2 rewrite add_assoc. rewrite (add_comm n' m'). trivial.
Qed.
(* begin hide *)

Lemma mul_add_r :
  forall a b c : nat,
    mul a (add b c) = add (mul a b) (mul a c).
(* begin hide *)
Proof.
  induction a as [| a']; cbn; trivial.
  intros. rewrite IHa'. repeat rewrite add_assoc.
  f_equal. repeat rewrite <- add_assoc. f_equal.
  apply add_comm.
Qed.
(* end hide *)

Lemma mul_add_l :
  forall a b c : nat,
    mul (add a b) c = add (mul a c) (mul b c).
(* begin hide *)
Proof.
  intros. rewrite mul_comm. rewrite mul_add_r.
  f_equal; apply mul_comm.
Qed.
(* end hide *)

Lemma mul_sub_r :
  forall a b c : nat,
    mul a (sub b c) = sub (mul a b) (mul a c).
(* begin hide *)
Proof.
  induction a as [| a']; cbn; trivial.
  induction b as [| b'].
    intros. repeat rewrite mul_0_r. cbn. trivial.
    induction c as [| c'].
      rewrite mul_0_r. cbn. trivial.
      cbn. rewrite (mul_comm a' (S b')). cbn.
        rewrite (mul_comm a' (S c')). cbn.
        rewrite IHb'. repeat rewrite sub_add_r.
        f_equal. 2: apply mul_comm.
        replace (add b' (add a' _)) with (add a' (add b' (mul b' a'))).
          rewrite sub_exchange. rewrite sub_add_l.
            rewrite mul_comm. trivial.
          repeat rewrite add_assoc. rewrite (add_comm a' b'). trivial.
Qed.
(* end hide *)

Lemma mul_sub_l :
  forall a b c : nat,
    mul (sub a b) c = sub (mul a c) (mul b c).
(* begin hide *)
Proof.
  intros. rewrite mul_comm. rewrite mul_sub_r.
  f_equal; apply mul_comm.
Qed.
(* end hide *)

Lemma mul_assoc :
  forall a b c : nat,
    mul a (mul b c) = mul (mul a b) c.
(* begin hide *)
Proof.
  induction a as [| a']; cbn; trivial.
  intros. rewrite mul_add_l.
  rewrite IHa'. trivial.
Qed.
(* end hide *)

Lemma mul_no_inverse_l :
  ~ forall n : nat, exists i : nat, mul i n = 1.
(* begin hide *)
Proof.
  intro. destruct (H (S 1)) as [i H']. rewrite mul_comm in H'.
  cbn in H'. rewrite add_0_r in H'. destruct i.
    inversion H'.
    cbn in H'. rewrite add_comm in H'. cbn in H'. inversion H'.
Qed.
(* end hide *)

Lemma mul_no_inverse_r :
  ~ forall n : nat, exists i : nat, mul n i = 1.
(* begin hide *)
Proof.
  intro. destruct (H (S 1)) as [i H']. cbn in H'.
  rewrite add_0_r in H'. destruct i.
    inversion H'.
    cbn in H'. rewrite add_comm in H'. cbn in H'. inversion H'.
Qed.
(* end hide *)

Lemma mul_no_inverse_l_strong :
  forall n i : nat, n <> 1 -> mul i n <> 1.
(* begin hide *)
Proof.
  induction i; cbn; intros.
    inversion 1.
    destruct n as [| [| n']]; cbn.
      rewrite mul_0_r. assumption.
      contradiction H. reflexivity.
      inversion 1.
Qed.
(* end hide *)

Lemma mul_no_inverse_r_strong :
  forall n i : nat, n <> 1 -> mul n i <> 1.
(* begin hide *)
Proof.
  intros. rewrite mul_comm.
  apply mul_no_inverse_l_strong. assumption.
Qed.
(* end hide *)

Lemma mul_2_l :
  forall n : nat, mul 2 n = add n n.
(* begin hide *)
Proof.
  intro. cbn. rewrite add_0_r. trivial.
Qed.
(* end hide *)

(** ** Potęgowanie *)

(** Zdefiniuj potęgowanie i udowodnij jego właściwości. *)

(* begin hide *)
Fixpoint pow (n m : nat) : nat :=
match m with
| 0 => 1
| S m' => mul n (pow n m')
end.
(* end hide *)

Lemma pow_0_r :
  forall n : nat,
    pow n 0 = 1.
(* begin hide *)
Proof. reflexivity. Qed.
(* end hide *)

Lemma pow_0_l :
  forall n : nat,
    pow 0 (S n) = 0.
(* begin hide *)
Proof.
  destruct n; cbn; reflexivity.
Qed.
(* end hide *)

Lemma pow_1_l :
  forall n : nat,
    pow 1 n = 1.
(* begin hide *)
Proof.
  induction n as [| n']; cbn; try rewrite add_0_r; trivial.
Qed.
(* end hide *)

Lemma pow_1_r :
  forall n : nat,
    pow n 1 = n.
(* begin hide *)
Proof.
  induction n as [| n']; cbn; try rewrite mul_1_r; trivial.
Qed.
(* end hide *)

Lemma pow_no_neutr_l :
  ~ exists e : nat, forall n : nat, pow e n = n.
(* begin hide *)
Proof.
  destruct 1 as [e H]. specialize (H 0). cbn in H. inversion H.
Qed.
(* end hide *)

Lemma pow_no_absorbing_r :
  ~ exists a : nat, forall n : nat, pow n a = a.
(* begin hide *)
Proof.
  destruct 1 as [a H]. destruct a;
  [specialize (H 1) | specialize (H 0)]; inversion H.
Qed.
(* end hide *)

Lemma pow_add :
  forall a b c : nat,
    pow a (add b c) = mul (pow a b) (pow a c).
(* begin hide *)
Proof.
  induction b as [| b']; induction c as [| c']; cbn.
    reflexivity.
    rewrite add_0_r. reflexivity.
    rewrite add_0_r, mul_1_r. reflexivity.
    rewrite IHb'. cbn. rewrite !mul_assoc. reflexivity.
Qed.
(* end hide *)

Lemma pow_mul_l :
  forall a b c : nat,
    pow (mul a b) c = mul (pow a c) (pow b c).
(* begin hide *)
Proof.
  induction c as [| c']; cbn.
    trivial.
    rewrite IHc'. repeat rewrite mul_assoc. f_equal.
      repeat rewrite <- mul_assoc. f_equal. apply mul_comm.
Qed.
(* end hide *)

Lemma pow_pow_l :
  forall a b c : nat,
    pow (pow a b) c = pow a (mul b c).
(* begin hide *)
Proof.
  induction c as [| c']; cbn.
    rewrite mul_0_r. cbn. trivial.
    rewrite IHc', (mul_comm b (S c')). cbn.
      rewrite <- pow_add. rewrite mul_comm. trivial.
Qed.
(* end hide *)

(** * Porządek *)

(** ** Porządek [<=] *)

(** Zdefiniuj relację "mniejszy lub równy" i udowodnij jej właściwości. *)

(* begin hide *)
Inductive le (n : nat) : nat -> Prop :=
| le_n : le n n
| le_S : forall m : nat, le n m -> le n (S m).
(* end hide *)

Notation "n <= m" := (le n m).

Lemma le_0_l :
  forall n : nat, 0 <= n.
(* begin hide *)
Proof.
  induction n as [| n'].
    apply le_n.
    apply le_S. assumption.
Qed.
(* end hide *)

Lemma le_n_Sm :
  forall n m : nat, n <= m -> n <= S m.
(* begin hide *)
Proof.
  apply le_S.
Qed.
(* end hide *)

Lemma le_Sn_m :
  forall n m : nat, S n <= m -> n <= m.
(* begin hide *)
Proof.
  induction m as [| m'].
    inversion 1.
    intros. inversion H.
      apply le_S, le_n.
      apply le_S, IHm'. assumption.
Qed.
(* end hide *)

Lemma le_n_S :
  forall n m : nat, n <= m -> S n <= S m.
(* begin hide *)
Proof.
  induction 1.
    apply le_n.
    apply le_S. assumption.
Qed.
(* end hide *)

Lemma le_S_n :
  forall n m : nat, S n <= S m -> n <= m.
(* begin hide *)
Proof.
  intros n m. generalize dependent n. induction m as [| m'].
    intros. inversion H.
      apply le_n.
      inversion H1.
    inversion 1.
      apply le_n.
      apply le_S. apply IHm'. assumption.
Qed.
(* end hide *)

Lemma le_Sn_n :
  forall n : nat, ~ S n <= n.
(* begin hide *)
Proof.
  induction n as [| n']; intro.
    inversion H.
    apply IHn'. apply le_S_n. assumption.
Qed.
(* end hide *)

Lemma le_refl :
  forall n : nat, n <= n.
(* begin hide *)
Proof.
  apply le_n.
Qed.
(* end hide *)

Lemma le_trans :
  forall a b c : nat,
    a <= b -> b <= c -> a <= c.
(* begin hide *)
Proof.
  induction 1.
    trivial.
    intro. apply IHle. apply le_Sn_m. assumption.
Qed.
(* end hide *)

Lemma le_antisym :
  forall n m : nat,
    n <= m -> m <= n -> n = m.
(* begin hide *)
Proof.
  induction n as [| n'].
    inversion 2. trivial.
    induction m as [| m'].
      inversion 1.
      intros. f_equal. apply IHn'; apply le_S_n; assumption.
Qed.
(* end hide *)

Lemma le_pred :
  forall n : nat, pred n <= n.
(* begin hide *)
Proof.
  destruct n; cbn; repeat constructor.
Qed.
(* end hide *)

Lemma le_n_pred :
  forall n m : nat,
    n <= m -> pred n <= pred m.
(* begin hide *)
Proof.
  inversion 1.
    constructor.
    cbn. apply le_trans with n.
      apply le_pred.
      assumption.
Qed.
(* end hide *)

Lemma no_le_pred_n :
  ~ forall n m : nat,
      pred n <= pred m -> n <= m.
(* begin hide *)
Proof.
  intro. specialize (H 1 0 (le_n 0)). inversion H.
Qed.
(* end hide *)

Lemma le_add_l :
  forall a b c : nat,
    b <= c -> add a b <= add a c.
(* begin hide *)
Proof.
  induction a as [| a']; cbn.
    trivial.
    intros. apply le_n_S. apply IHa'. assumption.
Qed.
(* end hide *)

Lemma le_add_r :
  forall a b c : nat,
    a <= b -> add a c <= add b c.
(* begin hide *)
Proof.
  intros. rewrite (add_comm a c), (add_comm b c).
  apply le_add_l. assumption.
Qed.
(* end hide *)

Lemma le_add :
  forall a b c d : nat,
    a <= b -> c <= d -> add a c <= add b d.
(* begin hide *)
Proof.
  induction 1.
    apply le_add_l.
    intros. cbn. apply le_S. apply IHle. assumption.
Qed.
(* end hide *)

Lemma le_sub_S_S :
  forall n m : nat,
    sub n (S m) <= sub n m.
(* begin hide *)
Proof.
  induction n as [| n'].
    cbn. constructor.
    destruct m; cbn.
      rewrite sub_0_r. do 2 constructor.
      apply IHn'.
Qed.
(* end hide *)

Lemma le_sub_l :
  forall a b c : nat,
    b <= c -> sub a c <= sub a b.
(* begin hide *)
Proof.
  induction 1.
    constructor.
    apply le_trans with (sub a m).
      apply le_sub_S_S.
      assumption.
Qed.
(* end hide *)

Lemma le_sub_r :
  forall a b c : nat,
    a <= b -> sub a c <= sub b c.
(* begin hide *)
Proof.
  intros a b c. generalize dependent a. generalize dependent b.
  induction c as [| c'].
    intros. do 2 rewrite sub_0_r. trivial.
    destruct a, b; cbn; intro; trivial.
      apply le_0_l.
      inversion H.
      apply IHc'. apply le_S_n. assumption.
Qed.
(* end hide *)

Lemma le_mul_l :
  forall a b c : nat,
    b <= c -> mul a b <= mul a c.
(* begin hide *)
Proof.
  induction a as [| a']; cbn.
    constructor.
    intros. apply le_add.
      assumption.
      apply IHa'. assumption.
Qed.
(* end hide *)

Lemma le_mul_r :
  forall a b c : nat,
    a <= b -> mul a c <= mul b c.
(* begin hide *)
Proof.
  intros. rewrite (mul_comm a c), (mul_comm b c).
  apply le_mul_l. assumption.
Qed.
(* end hide *)

Lemma le_mul :
  forall a b c d : nat,
    a <= b -> c <= d -> mul a c <= mul b d.
(* begin hide *)
Proof.
  induction 1; cbn; intro.
    apply le_mul_l. assumption.
    change (mul a c) with (add 0 (mul a c)). apply le_add.
      apply le_0_l.
      apply IHle. assumption.
Qed.
(* end hide *)

Lemma le_add_exists :
  forall n m : nat,
    n <= m -> exists k : nat, add n k = m.
(* begin hide *)
Proof.
  induction n as [| n']; cbn.
    intros. exists m. trivial.
    intros. destruct (IHn' m) as [k Hk].
      apply le_Sn_m in H. assumption.
      destruct k; cbn.
        rewrite add_0_r in Hk. subst. cut False.
          inversion 1.
          apply (le_Sn_n m). assumption.
        exists k. rewrite add_comm in Hk. cbn in Hk.
          rewrite add_comm. assumption.
Qed.
(* end hide *)

Lemma le_pow_l :
  forall a b c : nat,
    a <> 0 -> b <= c -> pow a b <= pow a c.
(* begin hide *)
Proof.
  induction 2.
    constructor.
    destruct a; cbn.
      contradiction H. trivial.
      change (pow (S a) b) with (add 0 (pow (S a) b)).
        rewrite (add_comm (pow (S a) m) _). apply le_add.
          apply le_0_l.
          assumption.
Qed.
(* end hide *)

Lemma le_pow_r :
  forall a b c : nat,
    a <= b -> pow a c <= pow b c.
(* begin hide *)
Proof.
  induction c as [| c']; cbn.
    constructor.
    intro. apply le_mul; auto.
Qed.
(* end hide *)

Lemma sub'_0 :
  forall n m : nat,
    sub' n m = 0 -> n <= m.
(* begin hide *)
Proof.
  intros n m. revert n.
  induction m as [| m']; cbn; intros.
    rewrite H. constructor.
    destruct n as [| n']; cbn.
      apply le_0_l.
      apply le_n_S, IHm'. rewrite pred_sub'_S in H. assumption.
Qed.
(* end hide *)

Lemma sub'_S_l :
  forall n m : nat,
    m <= n -> sub' (S n) m = S (sub' n m).
(* begin hide *)
Proof.
  induction m as [| m']; cbn; intros.
    reflexivity.
    rewrite IHm'.
      cbn. destruct (sub' n m') eqn: Heq.
        apply sub'_0 in Heq. edestruct le_Sn_n. eapply le_trans.
          exact H.
          assumption.
        cbn. reflexivity.
      eapply le_trans with (S m').
        do 2 constructor.
        assumption.
Qed.
(* end hide *)

Lemma le_sub'_l :
  forall n m : nat,
    sub' n m <= n.
(* begin hide *)
Proof.
  induction m as [| m']; cbn.
    constructor.
    apply le_trans with (sub' n m').
      apply le_pred.
      assumption.
Qed.
(* end hide *)

Lemma sub'_inv :
  forall n m : nat,
    m <= n -> sub' n (sub' n m) = m.
(* begin hide *)
Proof.
  intros n m. revert n.
  induction m as [| m']; intros.
    rewrite sub'_0_r, sub'_diag. reflexivity.
    induction n as [| n'].
      inversion H.
      cbn. rewrite pred_sub'_S, sub'_S_l, IHm'.
        reflexivity.
        apply le_S_n. assumption.
        apply le_sub'_l.
Qed.
(* end hide *)

(** ** Porządek [<] *)

Definition lt (n m : nat) : Prop := S n <= m.

Notation "n < m" := (lt n m).

Lemma lt_irrefl :
  forall n : nat, ~ n < n.
(* begin hide *)
Proof.
  unfold lt, not; intros. apply le_Sn_n in H. assumption.
Qed.
(* end hide *)

Lemma lt_trans :
  forall a b c : nat, a < b -> b < c -> a < c.
(* begin hide *)
Proof.
  unfold lt; intros. destruct b.
    inversion H.
    destruct c as [| [| c']].
      inversion H0.
      inversion H0. inversion H2.
      apply le_S_n in H0. constructor. eapply le_trans; eauto.
Qed.
(* end hide *)

Lemma lt_asym :
  forall n m : nat, n < m -> ~ m < n.
(* begin hide *)
Proof.
  unfold lt, not; intros. cut (S n <= n).
    intro. apply le_Sn_n in H1. assumption.
    apply le_trans with m.
      assumption.
      apply le_Sn_m. assumption.
Qed.
(* end hide *)

(** ** Minimum i maksimum *)

(** Zdefiniuj operacje brania minimum i maksimum z dwóch liczb naturalnych
    oraz udowodnij ich właściwości. *)

(* begin hide *)
Fixpoint min (n m : nat) : nat :=
match n, m with
| 0, _ => 0
| _, 0 => 0
| S n', S m' => S (min n' m')
end.

Fixpoint max (n m : nat) : nat :=
match n, m with
| 0, _ => m
| _, 0 => n
| S n', S m' => S (max n' m')
end.
(* end hide *)

Lemma min_0_l :
  forall n : nat, min 0 n = 0.
(* begin hide *)
Proof. reflexivity. Qed.
(* end hide *)

Lemma min_0_r :
  forall n : nat, min n 0 = 0.
(* begin hide *)
Proof.
  destruct n; cbn; reflexivity.
Qed.
(* end hide *)

Lemma max_0_l :
  forall n : nat, max 0 n = n.
(* begin hide *)
Proof. reflexivity. Qed.
(* end hide *)

Lemma max_0_r :
  forall n : nat, max n 0 = n.
(* begin hide *)
Proof.
  destruct n; cbn; reflexivity.
Qed.
(* end hide *)

Lemma min_le :
  forall n m : nat, n <= m -> min n m = n.
(* begin hide *)
Proof.
  induction n as [| n'].
    trivial.
    destruct m as [| m'].
      inversion 1.
      intro. cbn. f_equal. apply IHn'. apply le_S_n. assumption.
Qed.
(* end hide *)

Lemma max_le :
  forall n m : nat, n <= m -> max n m = m.
(* begin hide *)
Proof.
  induction n as [| n'].
    trivial.
    destruct m as [| m'].
      inversion 1.
      intro. cbn. f_equal. apply IHn'. apply le_S_n. assumption.
Qed.
(* end hide *)

Lemma min_assoc :
  forall a b c : nat,
    min a (min b c) = min (min a b) c.
(* begin hide *)
Proof.
  induction a as [| a'].
    trivial.
    destruct b, c; auto. cbn. rewrite IHa'. trivial.
Qed.
(* end hide *)

Lemma max_assoc :
  forall a b c : nat,
    max a (max b c) = max (max a b) c.
(* begin hide *)
Proof.
  induction a as [| a'].
    trivial.
    destruct b, c; auto. cbn. rewrite IHa'. trivial.
Qed.
(* end hide *)

Lemma min_comm :
  forall n m : nat, min n m = min m n.
(* begin hide *)
Proof.
  induction n as [| n']; destruct m; cbn; try rewrite IHn'; trivial.
Qed.
(* end hide *)

Lemma max_comm :
  forall n m : nat, max n m = max m n.
(* begin hide *)
Proof.
  induction n as [| n']; destruct m; cbn; try rewrite IHn'; trivial.
Qed.
(* end hide *)

Lemma min_refl :
  forall n : nat, min n n = n.
(* begin hide *)
Proof.
  induction n as [| n']; cbn; try rewrite IHn'; trivial.
Qed.
(* end hide *)

Lemma max_refl :
  forall n : nat, max n n = n.
(* begin hide *)
Proof.
  induction n as [| n']; cbn; try rewrite IHn'; trivial.
Qed.
(* end hide *)

Lemma min_no_neutr_l :
  ~ exists e : nat, forall n : nat, min e n = n.
(* begin hide *)
Proof.
  intro. destruct H as [e H]. specialize (H (S e)).
  induction e.
    inversion H.
    cbn in H. inversion H. apply IHe. assumption.
Qed.
(* end hide *)

Lemma min_no_neutr_r :
  ~ exists e : nat, forall n : nat, min n e = n.
(* begin hide *)
Proof.
  intro. apply min_no_neutr_l. destruct H as [e H].
  exists e. intro. rewrite min_comm. apply H.
Qed.
(* end hide *)

Lemma max_no_absorbing_l :
  ~ exists a : nat, forall n : nat, max a n = a.
(* begin hide *)
Proof.
  intro. destruct H as [a H]. specialize (H (S a)).
  induction a; inversion H. apply IHa. assumption.
Qed.
(* end hide *)

Lemma max_no_absorbing_r :
  ~ exists a : nat, forall n : nat, max n a = a.
(* begin hide *)
Proof.
  intro. destruct H as [a H]. apply max_no_absorbing_l.
  exists a. intro. rewrite max_comm. apply H.
Qed.
(* end hide *)

Lemma is_it_true :
  (forall n m : nat, min (S n) m = S (min n m)) \/
  (~ forall n m : nat, min (S n) m = S (min n m)).
(* begin hide *)
Proof.
  right. intro. specialize (H 0 0). cbn in H. inversion H.
Qed.
(* end hide *)

(** * Rozstrzygalność *)

(** ** Rozstrzygalność porządku *)

(** Zdefiniuj funkcję [leb], która sprawdza, czy [n <= m]. *)

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

Lemma leb_n :
  forall n : nat,
    leb n n = true.
(* begin hide *)
Proof.
  induction n as [| n']; cbn; trivial.
Qed.
(* end hide *)

Lemma leb_spec :
  forall n m : nat,
    n <= m <-> leb n m = true.
(* begin hide *)
Proof.
  split; generalize dependent m.
    induction n as [| n'].
      cbn. trivial.
      destruct m; cbn; intro.
        inversion H.
        apply IHn'. apply le_S_n. assumption.
    induction n as [| n']; intros.
      apply le_0_l.
      destruct m; cbn.
        cbn in H. inversion H.
        cbn in H. apply le_n_S. apply IHn'. assumption.
Restart.
  split; generalize dependent m; induction n as [| n']; destruct m;
  cbn; trivial; try (inversion 1; fail); intro.
    apply IHn'. apply le_S_n. assumption.
    apply le_n.
    apply le_0_l.
    apply le_n_S. apply IHn'. assumption.
Qed.
(* end hide *)

(** ** Rozstrzygalność równości *)

(** Zdefiniuj funkcję [eqb], która sprawdza, czy [n = m]. *)

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

Lemma eqb_spec :
  forall n m : nat,
    n = m <-> eqb n m = true.
(* begin hide *)
Proof.
  split; generalize dependent m; generalize dependent n.
    destruct 1. induction n; auto.
    induction n as [| n']; destruct m as [| m']; cbn; inversion 1; auto.
      f_equal. apply IHn'. assumption.
Qed.
(* end hide *)

(** * Dzielenie i podzielność *)

(** ** Dzielenie przez 2 *)

(** Pokaż, że indukcję na liczbach naturalnych można robić "co 2".
    Wskazówka: taktyk można używać nie tylko do dowodzenia. Przypomnij
    sobie, że taktyki to programy, które generują dowody, zaś dowody
    są programami. Dzięki temu nic nie stoi na przeszkodzie, aby
    taktyki interpretować jako programy, które piszą inne programy.
    I rzeczywiście — w Coqu możemy używać taktyk do definiowania
    dowolnych termów. W niektórych przypadkach jest to bardzo częsta
    praktyka. *)

Fixpoint nat_ind_2
  (P : nat -> Prop) (H0 : P 0) (H1 : P 1)
  (HSS : forall n : nat, P n -> P (S (S n))) (n : nat) : P n.
(* begin hide *)
Proof.
  destruct n.
    apply H0.
    destruct n.
      apply H1.
      apply HSS. apply nat_ind_2; auto.
Qed.
(* end hide *)

(** Zdefiniuj dzielenie całkowitoliczbowe przez [2] oraz funkcję obliczającą
    resztę z dzielenia przez [2]. *)

(* begin hide *)
Fixpoint div2 (n : nat) : nat :=
match n with
| 0 => 0
| 1 => 0
| S (S n') => S (div2 n')
end.

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

Lemma div2_even :
  forall n : nat, div2 (mul 2 n) = n.
(* begin hide *)
Proof.
  apply nat_ind_2; cbn; intros; trivial.
  rewrite add_0_r in *. rewrite ?add_S_r. cbn. rewrite H. trivial.
Qed.
(* end hide *)

Lemma div2_odd :
  forall n : nat, div2 (S (mul 2 n)) = n.
(* begin hide *)
Proof.
  apply nat_ind_2; cbn; intros; trivial.
  rewrite add_0_r in *. rewrite ?add_S_r. cbn. rewrite H. trivial.
Qed.
(* end hide *)

Lemma mod2_even :
  forall n : nat, mod2 (mul 2 n) = 0.
(* begin hide *)
Proof.
  apply nat_ind_2; cbn; intros; trivial.
  rewrite add_0_r, ?add_S_r in *. cbn. rewrite H. trivial.
Qed.
(* end hide *)

Lemma mod2_odd :
  forall n : nat, mod2 (S (mul 2 n)) = 1.
(* begin hide *)
Proof.
  apply nat_ind_2; cbn; intros; trivial.
  rewrite add_0_r, ?add_S_r in *. cbn. rewrite H. trivial.
Qed.
(* end hide *)

Lemma div2_mod2_spec :
  forall n : nat, add (mul 2 (div2 n)) (mod2 n) = n.
(* begin hide *)
Proof.
  apply nat_ind_2; cbn; intros; trivial.
  rewrite add_0_r in *. rewrite add_S_r. cbn. rewrite H. trivial.
Qed.
(* end hide *)

Lemma div2_le :
  forall n : nat, div2 n <= n.
(* begin hide *)
Proof.
  apply nat_ind_2; cbn; intros; trivial; try (repeat constructor; fail).
  apply le_n_S. constructor. assumption.
Qed.
(* end hide *)

Lemma div2_pres_le :
  forall n m : nat, n <= m -> div2 n <= div2 m.
(* begin hide *)
Proof.
  induction n using nat_ind_2; cbn; intros; try apply le_0_l.
  destruct m as [| [| m']]; cbn.
    inversion H.
    inversion H. inversion H1.
    apply le_n_S, IHn. do 2 apply le_S_n. assumption.
Qed.
(* end hide *)

Lemma mod2_le :
  forall n : nat, mod2 n <= n.
(* begin hide *)
Proof.
  apply nat_ind_2; cbn; intros; trivial; repeat constructor; assumption.
Qed.
(* end hide *)

Lemma mod2_not_pres_e :
  exists n m : nat, n <= m /\ mod2 m <= mod2 n.
(* begin hide *)
Proof.
  exists (S (S (S 0))), (S (S (S (S 0)))). cbn.
  split; repeat constructor.
Qed.
(* end hide *)

Lemma div2_lt :
  forall n : nat,
    0 <> n -> div2 n < n.
(* begin hide *)
Proof.
  induction n using nat_ind_2; cbn; intros.
    contradiction H. reflexivity.
    apply le_n.
    unfold lt in *. destruct n as [| n'].
      cbn. apply le_n.
      specialize (IHn ltac:(inversion 1)). apply le_n_S.
        apply le_trans with (S n').
          assumption.
          apply le_S, le_n.
Qed.
(* end hide *)

(** ** Podzielność *)

Module divides.

Definition divides (k n : nat) : Prop :=
  exists m : nat, mul k m = n.

Notation "k | n" := (divides k n) (at level 40).

(** [k] dzieli [n] jeżeli [n] jest wielokrotnością [k]. Udowodnij podstawowe
    właściwości tej relacji. *)

Lemma divides_0 :
  forall n : nat, n | 0.
(* begin hide *)
Proof.
  intro. red. exists 0. apply mul_0_r.
Qed.
(* end hide *)

Lemma not_divides_0 :
  forall n : nat, n <> 0 -> ~ 0 | n.
(* begin hide *)
Proof.
  unfold not, divides; intros. destruct H0 as [m Hm].
  rewrite mul_0_l in Hm. congruence.
Qed.
(* end hide *)

Lemma divides_1 :
  forall n : nat, 1 | n.
(* begin hide *)
Proof.
  intro. red. exists n. apply mul_1_l.
Qed.
(* end hide *)

Lemma divides_refl :
  forall n : nat, n | n.
(* begin hide *)
Proof.
  intro. red. exists 1. apply mul_1_r.
Qed.
(* end hide *)

Lemma divides_trans :
  forall k n m : nat, k | n -> n | m -> k | m.
(* begin hide *)
Proof.
  unfold divides; intros.
  destruct H as [c1 H1], H0 as [c2 H2].
  exists (mul c1 c2). rewrite mul_assoc. rewrite H1, H2. trivial.
Qed.
(* end hide *)

Lemma divides_add :
  forall k n m : nat, k | n -> k | m -> k | add n m.
(* begin hide *)
Proof.
  unfold divides; intros.
  destruct H as [c1 H1], H0 as [c2 H2].
  exists (add c1 c2). rewrite mul_add_r. rewrite H1, H2. trivial.
Qed.
(* end hide *)

Lemma divides_mul_l :
  forall k n m : nat, k | n -> k | mul n m.
(* begin hide *)
Proof.
  unfold divides. destruct 1 as [c H].
  exists (mul c m). rewrite mul_assoc. rewrite H. trivial.
Qed.
(* end hide *)

Lemma divides_mul_r :
  forall k n m : nat, k | m -> k | mul n m.
(* begin hide *)
Proof.
  intros. rewrite mul_comm. apply divides_mul_l. assumption.
Qed.
(* end hide *)

Lemma divides_le :
  ~ forall k n : nat, k | n -> k <= n.
(* begin hide *)
Proof.
  intro. cut (1 <= 0).
    inversion 1.
    apply H. red. exists 0. cbn. reflexivity.
Qed.
(* end hide *)

(* begin hide *)
Definition prime (p : nat) : Prop :=
  forall k : nat, k | p -> k = 1 \/ k = p.

Lemma double_not_prime :
  forall n : nat,
    n <> 1 -> ~ prime (mul 2 n).
Proof.
  unfold prime, not; intros.
  destruct (H0 2).
    red. exists n. reflexivity.
    inversion H1.
    destruct n as [| [| n']]; inversion H1.
      apply H. reflexivity.
      rewrite add_comm in H3. inversion H3.
Qed.
(* end hide *)

End divides.

(** * Silnia *)

(** Zdefiniuj silnię.

    Przykład:
    [fac 5 = 1 * 2 * 3 * 4 * 5 = 120]

*)

(* begin hide *)
Fixpoint fac (n : nat) : nat :=
match n with
| 0 => 1
| S n' => mul n (fac n')
end.
(* end hide *)

Lemma le_1_fac :
  forall n : nat, 1 <= fac n.
(* begin hide *)
Proof.
  induction n as [| n']; cbn.
    constructor.
    replace 1 with (add 1 0).
      apply le_add.
        assumption.
        apply le_0_l.
      apply add_comm.
Qed.
(* end hide *)

Lemma le_lin_fac :
  forall n : nat, n <= fac n.
(* begin hide *)
Proof.
  induction n as [| n']; cbn.
    apply le_0_l.
    replace (S n') with (add 1 n') by reflexivity.
      apply le_add.
        apply le_1_fac.
        replace n' with (mul n' 1) at 1.
          apply le_mul.
            apply le_n.
            apply le_1_fac.
          apply mul_1_r.
Qed.
(* end hide *)

Fixpoint pow2 (n : nat) : nat :=
match n with
| 0 => 1
| S n' => mul 2 (pow2 n')
end.

Notation "4" := (S (S (S (S 0)))).

Lemma le_exp_fac :
  forall n : nat, 4 <= n -> pow2 n <= fac n.
(* begin hide *)
Proof.
  induction 1; cbn.
    repeat constructor.
    rewrite add_0_r. apply le_add.
      assumption.
      replace (pow2 m) with (mul 1 (pow2 m)).
        apply le_mul.
          apply le_trans with 4; auto. repeat constructor.
          assumption.
        apply mul_1_l.
Qed.
(* end hide *)

(** * Współczynnik dwumianowy (TODO) *)

(** Zdefiniuj współczynnik dwumianowy. Jeżeli nie wiesz co to, to dobrze:
    będziesz miał więcej zabawy. W skrócie [binom n k] to ilość podzbiorów
    zbioru [n] elementowego, którego mają [k] elementów. *)

(* begin hide *)
Function binom (n k : nat) : nat :=
match n, k with
| 0, 0 => 1
| 0, _ => 0
| _, 0 => 1
| S n', S k' => add (binom n' k') (binom n' k)
end.
(* TODO: być może przedefiniować współczynnik dwumianowy na bardziej ludzki *)
(* end hide *)

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

Lemma binom_0_r :
  forall n : nat, binom n 0 = 1.
(* begin hide *)
Proof.
  destruct n; cbn; reflexivity.
Qed.
(* end hide *)

Lemma binom_0_l :
  forall n : nat, binom 0 (S n) = 0.
(* begin hide *)
Proof.
  reflexivity.
Qed.
(* end hide *)

Lemma binom_1_r :
  forall n : nat, binom n 1 = n.
(* begin hide *)
Proof.
  induction n as [| n']; cbn.
    reflexivity.
    rewrite IHn', binom_0_r. cbn. reflexivity.
Qed.
(* end hide *)

Lemma binom_gt :
  forall n k : nat, n < k -> binom n k = 0.
(* begin hide *)
Proof.
  induction n as [| n'];
  destruct k as [| k']; cbn;
  try (inversion 1; trivial; fail); intro.
  rewrite !IHn'.
    reflexivity.
    apply lt_trans with (S n').
      apply le_n.
      assumption.
      apply le_S_n. assumption.
Qed.
(* end hide *)

Lemma binom_diag :
  forall n : nat, binom n n = 1.
(* begin hide *)
Proof.
  induction n as [| n']; cbn.
    reflexivity.
    rewrite IHn', binom_gt.
      reflexivity.
      constructor.
Qed.
(* end hide *)

Lemma binom_sym :
  forall n k : nat,
    k <= n -> binom n k = binom n (sub' n k).
(* begin hide *)
Proof.
  intros n k. revert n.
  induction k as [| k']; cbn; intros.
    rewrite binom_0_r, binom_diag. reflexivity.
    induction n as [| n']; cbn.
      inversion H.
      rewrite pred_sub'_S. destruct (sub' n' k') eqn: Heq.
        rewrite IHk', Heq, binom_0_r, binom_gt.
          reflexivity.
          apply sub'_0 in Heq. apply le_n_S. assumption.
          apply le_S_n. assumption.
        apply le_S_n in H. inversion H; subst; try rename m into n'.
          rewrite sub'_diag in Heq. inversion Heq.
          rewrite add_comm, IHn', IHk', Heq.
            reflexivity.
            assumption.
            apply le_n_S. assumption.
Qed.
(* end hide *)

Lemma sub_sub' :
  forall n m : nat,
    sub n m = sub' n m.
(* begin hide *)
Proof.
  induction n as [| n'];
  destruct  m as [| m'];
  cbn.
    reflexivity.
    rewrite sub'_0_l. cbn. reflexivity.
    reflexivity.
    rewrite IHn', pred_sub'_S. reflexivity.
Qed.
(* end hide *)

Lemma binom_sym' :
  forall n k : nat,
    k <= n -> binom n k = binom n (sub n k).
(* begin hide *)
Proof.
  intros.
  rewrite sub_sub'.
  apply binom_sym.
  assumption.
Qed.
(* end hide *)

Function binom' (n k : nat) : nat :=
match k with
| 0    => 1
| S k' =>
  match n with
  | 0    => 0
  | S n' => add (binom' n' k') (binom' n' k)
  end
end.

Lemma binom_S_S :
  forall n k : nat,
    mul (S k) (binom (S n) (S k)) = mul (S n) (binom n k).
(* begin hide *)
Proof.
  intros.
  functional induction binom n k;
  cbn.
    admit.
Admitted.
(* end hide *)

Lemma binom_spec :
  forall n k : nat,
    k <= n -> mul (fac k) (mul (fac (sub' n k)) (binom n k)) = fac n.
(* begin hide *)
Proof.
  induction n as [| n'].
    inversion 1; subst. cbn. reflexivity.
    destruct k as [| k'].
      intro. cbn. rewrite add_0_r, mul_1_r. reflexivity.
      {
        intros. cbn [sub']. rewrite pred_sub'_S. cbn [fac].
        replace (mul (mul (S k') _) _) with
                (mul (mul (S k') (binom (S n') (S k'))) (mul (fac k') (fac (sub' n' k')))).
          rewrite binom_S_S. replace (mul (mul _ _) _) with
                                     (mul (S n') (mul (fac k') (mul (fac (sub' n' k')) (binom n' k')))).
            rewrite IHn'.
              reflexivity.
              apply le_S_n. assumption.
            rewrite <- !mul_assoc. f_equal. rewrite (mul_comm (fac _)).
              rewrite <- !mul_assoc, mul_comm, <- !mul_assoc. reflexivity.
          rewrite <- !mul_assoc. f_equal. rewrite (mul_comm (binom _ _)).
              rewrite <- !mul_assoc, mul_comm, <- !mul_assoc. reflexivity.
      }
Qed.
(* end hide *)

(* begin hide *)
Module MyDiv2. (* TODO: szybkie mnożenie *)

Import Div2 ZArith.

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

(*
Fixpoint quickMul (fuel n m : nat) : nat :=
match fuel with
| 0 => 0
| S fuel' =>
  match n with
  | 0 => 0
  | _ =>
    let res := quickMul fuel' (div2 n) m in
      if evenb n then add res res else add (add m res) res
  end
end.

Time Eval compute in 430 * 110.
Time Eval compute in quickMul 1000 430 110.

Function qm (n m : nat) {measure id n} : nat :=
match n with
| 0 => 0
| _ =>
  let r := qm (div2 n) m in
    if evenb n then 2 * r else m + 2 * r
end.
Proof.
Abort.

*)
End MyDiv2.
(* end hide *)

(** * Wzory rekurencyjne (TODO) *)

(** * Sumy szeregów (TODO) *)

(** Udowodnij, że [2^0 + 2^1 + 2^2 + ... + 2^n = 2^(n + 1) - 1].
    Zaimplementuj w tym celu celu funkcję [f], która oblicza lewą
    stronę tego równania, a następnie pokaż, że [f n = 2^(n + 1) - 1]
    dla dowolnego [n : nat]. *)

(* begin hide *)
Fixpoint twos (n : nat) : nat :=
match n with
| 0 => pow2 0
| S n' => add (twos n') (pow2 n)
end.
(* end hide *)

Lemma twos_spec :
  forall n : nat, twos n = sub (pow2 (S n)) 1.
(* begin hide *)
Proof.
  induction n as [| n']; cbn.
    reflexivity.
    rewrite IHn'. cbn. rewrite !add_0_r.
      generalize dependent (add (pow2 n') (pow2 n')). destruct n.
        reflexivity.
        cbn. rewrite !sub_0_r. reflexivity.
Qed.
(* end hide *)

(* begin hide *)
(* TODO: dziwna indukcja (ale o co tu miało chodzić?) *)
(* end hide *)

End MyNat.

(** * Dyskretny pierwiastek kwadratowy (TODO) *)

(* begin hide *)

(** TODO: dyskretny pierwiastek kwadratowy *)

Require Import Lia Arith.

Lemma root : forall n : nat, {r : nat | r * r <= n < (S r) * (S r)}.
Proof.
  induction n as [| n'].
    exists 0. cbn; split.
      trivial.
      apply le_n.
    destruct IHn' as [r [H1 H2]].
    destruct (le_lt_dec ((S r) * (S r)) (S n')).
      exists (S r). cbn; split.
        cbn in l. assumption.
        cbn in *. rewrite <- Nat.succ_lt_mono.
        repeat match goal with
        | H : context [?x + S ?y] |- _ =>
          rewrite (add_comm x (S y)) in H; cbn in H
        | H : context [?x * S ?y] |- _ =>
          rewrite (mul_comm x (S y)) in H; cbn in H
        | |- context [?x + S ?y] => rewrite (add_comm x (S y)); cbn
        | |- context [?x * S ?y] => rewrite (mul_comm x (S y)); cbn
        end. lia.
      exists r. cbn; split.
        apply Nat.le_trans with n'.
          assumption.
          apply le_S. apply le_n.
        cbn in l. assumption.
Defined.

Definition root' (n : nat) : nat.
Proof.
  destruct (root n). exact x.
Defined.

Eval compute in root' 24.

Fixpoint div4 (n : nat) : nat :=
match n with
| 0 => 0
| 1 => 0
| 2 => 0
| 3 => 0
| S (S (S (S n'))) => S (div4 n')
end.

Fixpoint nat_ind_4 (P : nat -> Prop) (H0 : P 0) (H1 : P 1) (H2 : P 2) (H3 : P 3)
    (H4 : forall n : nat, P n -> P (S (S (S (S n))))) (n : nat) : P n.
Proof.
  destruct n.
    exact H0.
    destruct n.
    exact H1.
      destruct n.
        exact H2.
        destruct n.
          exact H3.
          apply H4. apply nat_ind_4; assumption.
Defined.

Fixpoint nat_ind_3 (P : nat -> Prop) (H0 : P 0) (H1 : P 1) (H2 : P 2)
    (H3 : forall n : nat, P n -> P (S (S (S n)))) (n : nat) : P n.
Proof.
  destruct n.
    exact H0.
    destruct n.
    exact H1.
      destruct n.
        exact H2.
        apply H3. apply nat_ind_3; assumption.
Defined.

Require Import Init.Wf.

Lemma div4_lemma : forall n : nat,
    S (div4 n) < S (S (S (S n))).
Proof.
  induction n using nat_ind_4; cbn; lia.
Qed.

Lemma nat_ind_div4 (P : nat -> Type) (H0 : P 0)
    (Hdiv : forall n : nat, P (div4 n) -> P n) (n : nat) : P n.
Proof.
  apply (Fix lt_wf P). intros.
  destruct x.
    apply H0.
    destruct x.
      apply Hdiv. cbn. apply H0.
      destruct x.
        apply Hdiv. cbn. apply H0.
        destruct x.
          apply Hdiv. cbn. apply H0.
          apply Hdiv. cbn. apply X. apply div4_lemma.
Defined.

Ltac nat_cbn := repeat
match goal with
| H : context [?x + S ?y] |- _ =>
    rewrite (Nat.add_comm x (S y)) in H; cbn in H
| H : context [?x * S ?y] |- _ =>
  rewrite (Nat.mul_comm x (S y)) in H; cbn in H
| |- context [?x + S ?y] => rewrite (Nat.add_comm x (S y)); cbn
| |- context [?x * S ?y] => rewrite (Nat.mul_comm x (S y)); cbn
end;
repeat rewrite Nat.add_0_r.

(* end hide *)

(** * Zadania *)

(** **** Ćwiczenie (przeszukiwanko) *)

Section reverse.

Context
  (f : nat -> nat)
  (Hzero : f 0 = 0)
  (Hincreasing : forall m n, m < n -> f m < f n).

(** Udowodnij, że przy powyższych założeniach dla każdego [y : nat] istnieje [x : nat]
    takie, że [f x <= y <= f (S x)]. Zdefiniuj w tym celu funkcję [g : nat -> nat] i
    udowodnij, że spełnia ona specyfikację. *)

(* begin hide *)

(** **** Rozwiązanie *)

(** Definicja jest prosta:
    - jeżeli [y] to [0], to zwróć [0]
    - jeżeli [x] który znaleźliśmy dla [y - 1] jest dalej ok, to zwróć [x]
    - w przeciwnym wypadku zwróć [x + 1] *)

Fixpoint g (y : nat) : nat :=
match y with
| 0 => 0
| S y' =>
  let x := g y' in
    if Nat.ltb y (f (S x))
    then x
    else S x
end.

(** Dowód też jest prosty i ma taki sam kształt jak definicja funkcji [g]. *)
Lemma g_correct : forall y (x := g y), f x <= y < f (S x).
Proof.
  induction y as [| y']; simpl.
  - split.
    + rewrite Hzero. apply le_n.
    + rewrite <- Hzero at 1. apply Hincreasing. lia.
  - destruct (Nat.ltb_spec (S y') (f (S (g y')))).
    + split.
      * destruct IHy'. lia.
      * assumption.
    + split.
      * assumption.
      * destruct IHy'. assert (f (S (g y')) < f (S (S (g y')))).
        -- apply Hincreasing. lia.
        -- lia.
Qed.

(** Uwaga: komenda [Function] nie upraszcza powyższego dowodu ani trochę. *)

(* end hide *)

End reverse.


(** * Geometric series definition and proof of convergence. *)

(** Divergent series are the devil, and it is a shame to base on them
    any demonstration whatsoever. (Niels Henrik Abel, 1826)
    (https://www.math.ucdavis.edu/~hunter/intro_analysis_pdf/ch4.pdf) *)

Set Implicit Arguments.

From Coq Require Import
  Lia
  Lra
  Reals
.

Local Open Scope R_scope.

From zar Require Import
  cpo
  eR
  order
  tactics
.

Fixpoint geometric_series (a r : eR) (n : nat) : eR :=
  match n with
  | O => 0
  | S n' => geometric_series a r n' + a * r ^ n'
  end.

Lemma eRmult_infty_inv a b :
  a * b = infty ->
  a = infty \/ b = infty.
Proof. intro Hab; destruct a, b; inv Hab; auto. Qed.

Lemma eRpow_infty_inv r i :
  r ^ i = infty ->
  r = infty.
Proof.
  revert r; induction i; simpl; intros r Hr.
  - inv Hr.
  - apply eRmult_infty_inv in Hr; destruct Hr; auto.
Qed.

Lemma geometric_series_sum (r : eR) (n : nat) :
  r < 1 ->
  geometric_series 1 r n = (1 - r ^ n) / (1 - r).
Proof.
  revert r; induction n; intros r Hr; simpl.
  { rewrite eRminus_cancel; eRauto. }
  rewrite eRmult_1_l.
  rewrite IHn; auto; clear IHn.
  replace ((1 - r ^ n) / (1 - r) + r ^ n) with
    ((1 - r ^ n) / (1 - r) + ((1 - r) * r ^ n) / (1 - r)).
  2: { rewrite eRmult_div_cancel; eRauto; intro HC.
       symmetry in HC; apply eRminus_eq_plus in HC; eRauto.
       rewrite eRplus_0_r in HC; subst.
       inv Hr; lra. }
  rewrite eRplus_combine_fract; f_equal.
  rewrite eRmult_minus_distr_r.
  2: { intro HC; apply eRpow_infty_inv in HC; subst; inv Hr. }
  rewrite eRmult_1_l.
  rewrite eRplus_minus_assoc.
  2: { intro HC; apply eRpow_infty_inv in HC; subst; inv Hr. }
  2: { eRauto. }
  f_equal.
  rewrite <- eRminus_assoc.
  { eRauto. }
  { apply eRpow_le_1; eRauto. }
  { reflexivity. }
  { intro HC; apply eRpow_infty_inv in HC; subst; inv Hr. }
Qed.

Lemma eRpow_pow a r n r1 r2 :
  er a r ^ n = er r1 r2 ->
  (a ^ n)%R = r1.
Proof.
  revert a r r1 r2; induction n; simpl; intros a r r1 r2 H.
  { inv H; reflexivity. }
  unfold eRmult in H.
  destruct (er a r ^ n) eqn:Har.
  - inv H; erewrite IHn; eauto.
  - apply eRpow_infty_inv in Har; inv Har.
Qed.

Lemma pow_seq_converges (a : eR) :
  a < 1 ->
  converges (eRpow a) 0.
Proof.
  intros Ha eps Heps.
  destruct a as [a|].
  2: { inv Ha. }
  inv Ha.
  destruct (Req_dec a 0); subst.
  - exists (S O); intros n Hn.
    unfold diff. simpl.
    destruct n; simpl; try lia.
    + rewrite eRmult_0_l'; simpl; destr.
      2: { exfalso; lra. }
      destruct eps; constructor; inv Heps; lra.
  - assert (Hr: R.converges_R (R.pow_sequence a) 0%R).
    { apply R.pow_sequence_converges'; lra. }
    unfold R.converges_R in Hr.
    destruct eps as [eps|].
    2: { exists O; intros n Hn.
         unfold diff; simpl.
         destruct (er a r ^ n) eqn:Hrn.
         - destr; constructor.
         - apply eRpow_infty_inv in Hrn; inv Hrn. }
    inv Heps.
    specialize (Hr eps H3).
    destruct Hr as [n0 Hr].
    exists n0; intros n Hn; specialize (Hr n Hn).
    unfold R.pow_sequence in Hr.
    unfold diff.
    rewrite Rabs_minus_sym in Hr.
    rewrite Rminus_0_r in Hr.
    destruct (er a r ^ n) eqn:Hrn; simpl.
    + destr.
      * constructor.
        rewrite Rabs_pos_eq in Hr.
        2: { apply pow_le; lra. }
        rewrite Rminus_0_r.
        eapply Rle_lt_trans.
        2: { apply Hr. }
        apply eRpow_pow in Hrn; lra.
      * constructor; lra.
    + apply eRpow_infty_inv in Hrn; inv Hrn.
Qed.

Lemma infimum_0_minus_supremum (a : eR) (f : nat -> eR) :
  dec_chain f ->
  upper_bound a f ->
  infimum 0 f ->
  supremum a (fun i => a - f i).
Proof.
  intros Hch Ha H0; split.
  - intro; eRauto.
  - intros x Hx; simpl.
    unfold upper_bound in Hx; simpl in Hx.
    destruct H0 as [Hlb Hglb]; simpl in *.
    assert (Haxf: lower_bound (a - x) f).
    { intro i; simpl.
      apply eRplus_le_minus.
      rewrite eRplus_comm.
      apply eRminus_le_plus; auto. }
    apply Hglb in Haxf.
    apply eRminus_le_plus in Haxf; rewrite eRplus_0_l in Haxf; auto.
Qed.

Lemma geometric_series_supremum_1 (r : eR) :
  r < 1 ->
  supremum (1 / (1 - r)) (geometric_series 1 r).
Proof.
  intro Hr.
  replace (geometric_series 1 r) with (fun n => (1 - r ^ n) / (1 - r)).
  2: { ext i; rewrite geometric_series_sum; auto. }
  replace (fun n : nat => (1 - r ^ n) / (1 - r)) with
    (fun n : nat => 1 / (1 - r) - r ^ n / (1 - r)).
  2: { ext i; rewrite eRdiv_minus_distr; eRauto.
       intro HC. symmetry in HC; apply eRminus_eq_plus in HC; eRauto.
       rewrite eRplus_0_r in HC; subst.
       inv Hr; lra. }
  apply infimum_0_minus_supremum.
  { intro i; simpl.
    unfold eRdiv.
    rewrite eRmult_assoc.
    apply eRmult_le_1_le; eRauto. }
  { intro i; simpl.
    apply eRle_div.
    apply eRpow_le_1; eRauto. }
  replace (fun i : nat => r ^ i / (1 - r)) with
    (fun i : nat => / (1 - r) * r ^ i).
  2: { ext i; rewrite eRmult_comm; reflexivity. }
  replace 0 with (/ (1 - r) * 0) by eRauto.
  apply infimum_scalar.
  { unfold eRinv, eRminus; simpl.
    destruct r as [r|]; simpl; inv Hr.
    destruct (Rle_dec r 1); simpl.
    - destr.
      + lra.
      + intro HC; inv HC.
    - lra. }
  { apply converges_infimum.
    - intro i; simpl.
      apply eRmult_le_1_le; eRauto.
    - intro i; intro HC; apply eRpow_infty_inv in HC; subst; inv Hr.
    - apply pow_seq_converges; auto. }
Qed.

Lemma geometric_series_scalar a r  i:
  geometric_series a r i = a * geometric_series 1 r i.
Proof.
  revert a r; induction i; intros a r; simpl.
  { eRauto. }
  rewrite IHi, eRmult_1_l, eRmult_plus_distr_l; reflexivity.
Qed.

Lemma geometric_series_supremum (a r : eR) :
  r < 1 ->
  supremum (a / (1 - r)) (geometric_series a r).
Proof.
  intro Hr.
  replace (geometric_series a r) with (fun i => a * geometric_series 1 r i).
  2: { ext i; rewrite <- geometric_series_scalar; reflexivity. }
  unfold eRdiv.
  apply supremum_scalar.
  replace (/ (1 - r)) with (1 / (1 - r)) by eRauto.
  apply geometric_series_supremum_1; auto.
Qed.

Corollary geometric_series_sup (a r : eR) :
  r < 1 ->
  sup (geometric_series a r) = a / (1 - r).
Proof.
  intro Hr; apply equ_eR, supremum_sup, geometric_series_supremum; auto.
Qed.


Parameter (Y : Type).
Axiom Y_eq_dec : forall (x y : Y), {x = y} + {~x = y}.
Parameter (ordre : Y -> Y -> Prop).
Axiom total_ordre : forall (x y : Y), {ordre x y} + {ordre y x}.
Hypothesis ordre_refl : forall y, ordre y y.
Hypothesis ordre_sym : forall x y, ordre x y /\ ordre y x -> x = y.
Hypothesis ordre_trans : forall x y z, ordre x y -> ordre y z -> ordre x z.
(*just some variables names to facilitate the definition of lhs and rhs*)
Variable (x : Y).
Variable (y : Y).
Variable (z : Y).

Inductive est_dans : Y -> list Y -> Prop :=
|construct: forall (x : Y) (l : list Y), est_dans x (cons x l)
|propag : forall (x y : Y) (l : list Y),  est_dans x l -> est_dans x (cons y l).

Inductive sans_doublon :list Y -> Prop :=
|cas_base_sd: sans_doublon nil
|cas_cons_sd : forall (l : list Y) (x : Y), sans_doublon l -> ~(est_dans x l) -> sans_doublon (cons x l).

Check ordre.

Inductive triee : list Y -> Prop :=
|cas_nil_tri : triee nil
|cas_x_tri : forall (x : Y), triee (cons x nil)
|cas_cons_tri : forall (x y: Y)(l : list Y), triee (x :: l) -> ordre y x  -> triee (cons y (cons x l )).
Require Import QArith.

Fixpoint calcul (phi : Y -> Q) (l  : list Y) : Q := match l with
|nil => 0%Q
|cons x q => phi x + calcul phi q
end.

Fixpoint inserer (x : Y) (l : list Y) : list Y :=
match l with
|nil => cons x nil
|cons y q => match (Y_eq_dec x y) with
             |left _ => l
             |right _ => match (total_ordre x y) with
                        |left _ => cons x (cons y q)
                        |right _ => cons y (inserer x q)
                      end
             end
end.

Fixpoint union (l l' : list Y) : list Y :=
match l with
|nil => l'
|cons y q => union q (inserer y l')
end.

Record ensemble_fini :=
{ensemble :>  list Y ;
is_a_set : sans_doublon ensemble ;
is_sorted : triee ensemble }.

Lemma tri_logique : forall (l : list Y) (x y : Y),
triee (cons x l) -> est_dans y l -> ordre x y.
Proof.
intros.
induction l.
inversion H0.
destruct (Y_eq_dec y0 a).
inversion H.
rewrite e.
auto.
apply IHl.
inversion H.
inversion H3.
apply cas_x_tri.
apply cas_cons_tri.
auto.
apply ordre_trans with (y := a).
auto.
auto.
inversion H0.
assert (False).
apply n.
auto.
inversion H2.
auto.
Qed.

Print tri_logique.

Lemma tri_cons_tri : forall (l : list Y) (a : Y),
triee (cons a l) -> triee l.
Proof.
intros.
induction l.
apply cas_nil_tri.
inversion H.
auto.
Qed.

Lemma tri_not_inside : forall (l : list Y) (a x0: Y) ,
triee (cons a l) -> x0 <> a -> ordre x0 a -> ~(est_dans x0 l).
Proof.
intros.
inversion H.
intro.
inversion H2.
rewrite <- H3 in H.
intro.
assert ({ordre x1 x0} + {ordre x0 x1}).
apply total_ordre.
destruct H7.
apply H0.
apply ordre_sym.
split.
auto.
apply ordre_trans with (y := x1).
auto.
auto.
assert ({x0 = x1}+ {x0 <> x1}).
apply Y_eq_dec.
destruct H7.
apply H0.
apply ordre_sym.
split.
auto.
rewrite e.
auto.
inversion H6.
apply n.
auto.
apply H0.
apply ordre_sym.
split.
auto.
apply ordre_trans with (y := x1).
auto.
apply tri_logique with (l := l0).
auto.
auto.
Qed.

Lemma insertion_preserves_inside : forall (l : list Y) (a x0 :Y),
est_dans a l -> est_dans a (inserer x0 l).
Proof.
intros.
induction l.
inversion H.
simpl.
destruct (Y_eq_dec x0 a0).
auto.
destruct (total_ordre x0 a0).
apply propag.
auto.
destruct (Y_eq_dec a a0).
rewrite e.
apply construct.
apply propag.
apply IHl.
inversion H.
assert (False).
apply n0.
auto.
inversion H1.
auto.
Qed.

Lemma insertion_alr_min : forall (l : list Y) (a : Y),
(forall (x : Y), est_dans x l -> ordre a x) -> ~est_dans a l-> (inserer a l = cons a l).
Proof.
intros.
induction l.
simpl.
reflexivity.
simpl.
destruct (Y_eq_dec a a0).
exfalso.
apply H0.
rewrite e.
apply construct.
destruct (total_ordre a a0).
reflexivity.
exfalso.
apply n.
apply ordre_sym.
split.
apply H.
apply construct.
auto.
Qed.

Lemma insertion_conserves_inside : forall (l : list Y) (a x0 :Y),
est_dans a (inserer x0 l) /\x0 <> a -> est_dans a l.
Proof.
intros.
induction l.
inversion H.
simpl.
simpl in H0.
inversion H0.
assert (False).
apply H1.
symmetry ; auto.
inversion H3.
auto.
destruct (Y_eq_dec a a0).
rewrite e.
apply construct.
apply propag.
apply IHl.
split.
simpl in H.
destruct (Y_eq_dec x0 a0).
destruct H.
inversion H.
assert (False).
apply n.
auto.
inversion H2.
apply insertion_preserves_inside.
auto.
destruct (total_ordre x0 a0).
destruct H.
inversion H.
assert (False).
apply H0.
symmetry.
auto.
inversion H2.
inversion H3.
assert (False).
apply n.
symmetry.
auto.
inversion H6.
apply insertion_preserves_inside.
auto.
destruct H.
inversion H.
assert (False).
apply n.
symmetry.
auto.
inversion H2.
auto.
destruct H.
auto.
Qed.

Lemma insertion_preserves_doublon : forall (l : list Y)(x0 a : Y),
sans_doublon (cons a l) -> x0 <> a -> ((est_dans a (inserer x0 l)) -> False).
Proof.
intros.
induction l.
simpl in H1.
inversion H1.
apply H0.
apply symmetry.
auto.
inversion H4.
simpl in H1.
destruct (Y_eq_dec x0 a0).
inversion H1.
inversion H.
apply H8.
rewrite H4.
apply construct.
apply IHl.
inversion H.
apply cas_cons_sd.
inversion H8.
auto.
intro.
apply H9.
auto.
apply insertion_preserves_inside.
auto.
destruct (total_ordre x0 a0).
apply IHl.
inversion H.
inversion H4.
apply cas_cons_sd.
auto.
intro.
apply H5.
apply propag.
auto.
assert (False).
apply IHl.
inversion H.
inversion H4.
apply cas_cons_sd.
auto.
intro.
apply H5.
apply propag.
auto.
apply insertion_preserves_inside.
inversion H1.
assert (False).
apply H0.
auto.
inversion H3.
inversion H4.
inversion H.
assert (False).
apply H12.
rewrite H8.
apply construct.
inversion H13.
auto.
inversion H2.
apply IHl.
inversion H.
inversion H4.
auto.
apply cas_cons_sd.
auto.
intro.
apply H5.
apply propag.
auto.
inversion H1.
inversion H.
assert (False).
apply H8.
rewrite H4.
apply construct.
inversion H9.
auto.
Qed.

Lemma sans_doublon_inserer : forall (l : list Y) (x : Y),
triee l -> sans_doublon l -> sans_doublon (inserer x l).
Proof.
intros.
induction l.
simpl.
apply cas_cons_sd.
auto.
intro.
inversion H1.
simpl.
destruct (Y_eq_dec x0 a).
exact H0.
destruct (total_ordre x0 a).
apply cas_cons_sd.
exact H0.
apply tri_not_inside with (a := a).
apply cas_cons_tri.
auto.
apply ordre_refl.
auto.
auto.
apply cas_cons_sd.
apply IHl.
inversion H.
apply cas_nil_tri.
auto.
inversion H0.
auto.
assert (est_dans a (inserer x0 l) -> False).
apply insertion_preserves_doublon with (x0 := x0) (a := a) (l := l).
auto.
auto.
auto.
Qed.

Lemma insertion_preserves_tri : forall (l : list Y)(a : Y),
sans_doublon l -> triee l -> triee (inserer a l).
Proof.
intros.
generalize dependent a.
induction l.
intros.
simpl.
apply cas_x_tri.
intros.
simpl.
destruct (Y_eq_dec a0 a).
auto.
destruct (total_ordre a0 a).
apply cas_cons_tri.
auto.
auto.
assert (triee (inserer a0 l)).
apply IHl.
inversion H.
auto.
inversion H0.
auto.
apply cas_nil_tri.
auto.
destruct l.
simpl.
apply cas_cons_tri.
auto.
auto.
simpl.
simpl in H1.
destruct (Y_eq_dec a0 y0).
auto.
destruct (total_ordre a0 y0).
apply cas_cons_tri.
apply cas_cons_tri.
inversion H0.
auto.
auto.
auto.
apply cas_cons_tri.
auto.
auto.
inversion H0.
auto.
Qed.

Lemma sans_doublon_union : forall (l l' : list Y),
sans_doublon l -> triee l -> sans_doublon l' -> triee l' -> sans_doublon (union l l').
Proof.
intros.
generalize dependent l'.
induction l.
simpl.
intros.
auto.
intros.
simpl.
apply IHl with (l' := inserer a l').
inversion H.
auto.
induction l'.
inversion H0.
auto.
auto.
apply IHl'.
inversion H1.
auto.
inversion H2.
apply cas_nil_tri.
auto.
apply sans_doublon_inserer.
auto.
auto.
apply insertion_preserves_tri.
auto.
auto.
Qed.

Lemma sorted_union : forall (l l' : list Y),
sans_doublon l -> triee l -> sans_doublon l' -> triee l' -> triee (union l l').
Proof.
intros.
generalize dependent l'.
induction l.
intros.
simpl.
auto.
intros.
simpl.
apply IHl with (l' := inserer a l').
inversion H.
auto.
inversion H0.
auto.
apply cas_nil_tri.
auto.
apply sans_doublon_inserer.
auto.
auto.
apply insertion_preserves_tri.
auto.
auto.
Qed.

Lemma union_not_null : forall (l l' :list Y),
l <> nil -> l' <> nil -> union l l' <> nil.
Proof.
intros.
generalize dependent l'.
induction l.
intros.
intro.
simpl in H1.
apply H0.
auto.
intros.
simpl.
destruct l.
simpl.
intro.
destruct l'.
simpl in H1.
inversion H1.
simpl in H1.
destruct(Y_eq_dec a y0).
inversion H1.
destruct (total_ordre a y0).
inversion H1.
inversion H1.
simpl.
apply IHl with (l' := inserer a l').
intro.
inversion H1.
intro.
destruct l'.
simpl in H1.
inversion H1.
simpl in H1.
destruct(Y_eq_dec a y1).
inversion H1.
destruct (total_ordre a y1).
inversion H1.
inversion H1.
Qed.

Lemma est_dedans_bien : forall (l : list Y) (a : Y),
est_dans a (inserer a l).
Proof.
intros.
induction l.
simpl.
apply construct.
simpl.
destruct (Y_eq_dec a a0).
rewrite e.
apply construct.
destruct (total_ordre a a0).
apply construct.
apply propag.
auto.
Qed.

Lemma transmission_gauche : forall (l l' : list Y) (a : Y),
est_dans a l -> est_dans a (union l l').
Proof.
intros.
generalize dependent l'.
induction l.
intro.
induction l'.
intros.
inversion H.
simpl in IHl'.
simpl.
apply propag.
auto.
intro.
inversion H.
simpl.
Admitted.

Lemma transmission_droite : forall (l l' : list Y) (a : Y),
est_dans a l -> est_dans a (union l' l).
Proof.
Admitted.

Lemma est_dans_already : forall (l : list Y) (a a0 : Y),
a <> a0 -> est_dans a (inserer a0 l) -> est_dans a l.
Proof.
intros.
induction l.
simpl in H0.
inversion H0.
assert (False).
apply H.
auto.
inversion H2.
inversion H3.
simpl in H0.
destruct (Y_eq_dec a0 a1).
apply propag.
apply IHl.
inversion H0.
assert (False).
apply H.
rewrite H3.
apply symmetry.
auto.
inversion H2.
apply insertion_preserves_inside.
auto.
destruct (Y_eq_dec a a1).
rewrite e.
apply construct.
apply propag.
destruct (total_ordre a0 a1).
inversion H0.
assert (False).
apply H.
auto.
inversion H2.
inversion H3.
assert (False).
apply n0.
auto.
inversion H6.
auto.
inversion H0.
assert (False).
apply n0.
auto.
inversion H2.
apply IHl.
auto.
Qed.

Lemma transmission_inverse : forall (l l' : list Y) (a :Y),
est_dans a (union l l') -> est_dans a l \/ est_dans a l'.
Proof.
intros.
generalize dependent l'.
induction l.
intros.
simpl in H.
right.
auto.
intros.
simpl in H.
assert (est_dans a l \/ est_dans a (inserer a0 l')).
apply IHl.
auto.
destruct H0.
left.
apply propag.
auto.
destruct (Y_eq_dec a a0).
rewrite e.
left.
apply construct.
right.
apply est_dans_already with (a := a) (a0 := a0).
auto.
auto.
Qed.

Lemma transmission_not : forall (l l' : list Y) (a : Y),
~est_dans a (union l l') -> ~est_dans a l /\ ~est_dans a l'.
Proof.
intros.
induction l.
split.
intro.
inversion H0.
simpl in H.
auto.
split.
intro.
apply H.
apply transmission_gauche.
auto.
intro.
apply H.
simpl.
assert (est_dans a l' -> est_dans a (inserer a0 l')).
apply (insertion_preserves_inside).
apply H1 in H0.
apply transmission_droite.
auto.
Qed.

Definition union_finite (A B : ensemble_fini) : ensemble_fini.
Proof.
split with (union A B).
apply sans_doublon_union.
apply is_a_set.
apply is_sorted.
apply is_a_set.
apply is_sorted.
apply sorted_union.
apply is_a_set.
apply is_sorted.
apply is_a_set.
apply is_sorted.
Defined.

Lemma union_preserves_both : forall (x : Y) (l l' : list Y),
est_dans x (union l l') -> est_dans x l \/ est_dans x l'.
Proof.
intros.
generalize dependent l'.
induction l.
intros.
induction l'.
simpl in H.
inversion H.
simpl in H.
simpl in IHl'.
right.
auto.
intros.
simpl in H.
destruct (Y_eq_dec x0 a).
left.
rewrite e.
apply construct.
assert (est_dans x0 l \/ est_dans x0 (inserer a l')).
apply IHl.
auto.
destruct H0.
left.
apply propag.
auto.
right.
apply insertion_conserves_inside with (x0 := a) (a := x0).
split.
auto.
intro.
apply n.
symmetry.
auto.
Qed.

Lemma est_dans_dec : forall (x: Y) (l : list Y), {est_dans x l} + {~est_dans x l}.
Proof.
intros.
induction l.
right.
intro.
inversion H.
destruct IHl.
left.
apply propag.
auto.
destruct (Y_eq_dec x0 a).
left.
rewrite e.
apply construct.
right.
intro.
inversion H.
apply n0.
auto.
apply n.
auto.
Qed.

Lemma equiv_tri : forall (l : list Y) (x : Y),
(forall (z : Y), est_dans z l -> ordre x z) -> triee l -> triee (cons x l).
Proof.
intros.
induction l.
apply cas_x_tri.
apply cas_cons_tri.
auto.
apply H.
apply construct.
Qed.

Definition singleton (x : Y) : ensemble_fini.
Proof.
split with (cons x nil).
apply cas_cons_sd.
apply cas_base_sd.
intro.
inversion H.
apply cas_x_tri.
Defined.


Require Import XR_Rmin.
Require Import XR_Rle_dec.

Local Open Scope R_scope.

Lemma Rmin_r : forall x y:R, Rmin x y <= y.
Proof.
  intros x y.
  unfold Rmin.
  destruct (Rle_dec x y) as [ hminl | hminr ].
  { exact hminl. }
  {
    right.
    reflexivity.
  }
Qed.


Set Warnings "-notation-overridden,-parsing".
Require Import Coq.Bool.Bool.
Require Import Coq.Arith.Arith.
Require Import Coq.Arith.EqNat.
Require Import Coq.omega.Omega.
Require Import Coq.Lists.List.
Require Import Coq.omega.Omega.
Import ListNotations.
Require Import maps.

(**Module AExp.
Inductive aexp : Type :=
  | ANum : nat -> aexp
  | APlus : aexp -> aexp -> aexp
  | AMinus : aexp -> aexp -> aexp
  | AMult : aexp -> aexp -> aexp.
Inductive bexp : Type :=
  | BTrue : bexp
  | BFalse : bexp
  | BEq : aexp -> aexp -> bexp
  | BLe : aexp -> aexp -> bexp
  | BNot : bexp -> bexp
  | BAnd : bexp -> bexp -> bexp.

Fixpoint aeval (a : aexp) : nat :=
  match a with
  | ANum n => n
  | APlus a1 a2 => (aeval a1) + (aeval a2)
  | AMinus a1 a2 => (aeval a1) - (aeval a2)
  | AMult a1 a2 => (aeval a1) * (aeval a2)
  end.

Example test_aeval1:
  aeval (APlus (ANum 2) (ANum 2)) = 4.
Proof. simpl.
reflexivity. Qed.

Fixpoint beval (b : bexp) : bool :=
  match b with
  | BTrue => true
  | BFalse => false
  | BEq a1 a2 => beq_nat (aeval a1) (aeval a2)
  | BLe a1 a2 => leb (aeval a1) (aeval a2)
  | BNot b1 => negb (beval b1)
  | BAnd b1 b2 => andb (beval b1) (beval b2)
  end.

Fixpoint optimize_0plus (a:aexp) : aexp :=
  match a with
  | ANum n =>
      ANum n
  | APlus (ANum 0) e2 =>
      optimize_0plus e2
  | APlus e1 e2 =>
      APlus (optimize_0plus e1) (optimize_0plus e2)
  | AMinus e1 e2 =>
      AMinus (optimize_0plus e1) (optimize_0plus e2)
  | AMult e1 e2 =>
      AMult (optimize_0plus e1) (optimize_0plus e2)
  end.

Theorem optimize_0plus_sound: forall a,
  aeval (optimize_0plus a) = aeval a.
Proof.
intros. induction a.
- simpl. reflexivity.
- destruct a1.
 + destruct n.
   * simpl. apply IHa2.
   * simpl. rewrite IHa2. trivial.
 + simpl. simpl in IHa1. rewrite IHa1. rewrite IHa2. trivial.
 + simpl. simpl in IHa1. rewrite IHa1. rewrite IHa2. trivial.
 + simpl. simpl in IHa1. rewrite IHa1. rewrite IHa2. trivial.
- simpl. rewrite IHa1. rewrite IHa2. trivial.
- simpl. rewrite IHa1. rewrite IHa2. trivial.
Qed.

Theorem silly1 : forall ae, aeval ae = aeval ae.
Proof. try reflexivity. (* this just does reflexivity *) Qed.
Theorem silly2 : forall (P : Prop), P -> P.
Proof.
  intros P HP.
  try reflexivity. (* just reflexivity would have failed *)
  apply HP. (* we can still finish the proof in some other way *)
Qed.

Lemma foo : forall n, leb 0 n = true.
Proof.
  intros.
  destruct n.
    (* Leaves two subgoals, which are discharged identically...  *)
    - (* n=0 *) simpl. reflexivity.
    - (* n=Sn' *) simpl. reflexivity.
Qed.

Lemma foo' : forall n, leb 0 n = true.
Proof.
  intros.
  (* destruct the current goal *)
  destruct n;
  (* then simpl each resulting subgoal *)
  simpl;
  (* and do reflexivity on each resulting subgoal *)
  reflexivity.
Qed.

Theorem optimize_0plus_sound': forall a,
  aeval (optimize_0plus a) = aeval a.
Proof.
  intros a.
  induction a;
    try (simpl; rewrite IHa1; rewrite IHa2; reflexivity).
  - (* ANum *) reflexivity.
  - (* APlus *)
    destruct a1;try (simpl; simpl in IHa1; rewrite IHa1;
           rewrite IHa2; reflexivity).
    + (* a1 = ANum n *) destruct n;
      simpl; rewrite IHa2; reflexivity. Qed.

Theorem In10 : In 10 [1;2;3;4;5;6;7;8;9;10].
Proof.
repeat simpl.
repeat (try (left; reflexivity); right).
Qed.

Fixpoint optimize_0plus_b (b : bexp) : bexp :=
match b with
  | BTrue => BTrue
  | BFalse => BFalse
  | BEq a1 a2 => BEq (optimize_0plus a1) (optimize_0plus a2)
  | BLe a1 a2 => BLe (optimize_0plus a1) (optimize_0plus a2)
  | BNot b1 => BNot (optimize_0plus_b b1)
  | BAnd b1 b2 => BAnd (optimize_0plus_b b1) (optimize_0plus_b b2)
  end.

Theorem optimize_0plus_b_sound:
  forall e, beval (optimize_0plus_b e) = beval e.
Proof.
  intro e.
  induction e;
    try reflexivity;
    try (simpl; rewrite 2 optimize_0plus_sound; reflexivity).
    simpl. rewrite IHe. reflexivity.
    simpl. rewrite IHe1. rewrite IHe2. reflexivity.
Qed.

Theorem optimize_0plus_b_sound' : forall b,
  beval (optimize_0plus_b b) = beval b.
Proof.
Admitted.

Tactic Notation "simpl_and_try" tactic(c) :=
  simpl;
  try c.

Example silly_presburger_example : forall m n o p,
  m + n <= n + o /\ o + 3 = p + 3 ->
  m <= p.
Proof.
  intros. omega.
Qed.

Module aevalR_first_try.
Inductive aevalR : aexp -> nat -> Prop :=
  | E_ANum : forall (n: nat),
      aevalR (ANum n) n
  | E_APlus : forall (e1 e2: aexp) (n1 n2: nat),
      aevalR e1 n1 ->
      aevalR e2 n2 ->
      aevalR (APlus e1 e2) (n1 + n2)
  | E_AMinus: forall (e1 e2: aexp) (n1 n2: nat),
      aevalR e1 n1 ->
      aevalR e2 n2 ->
      aevalR (AMinus e1 e2) (n1 - n2)
  | E_AMult : forall (e1 e2: aexp) (n1 n2: nat),
      aevalR e1 n1 ->
      aevalR e2 n2 ->
      aevalR (AMult e1 e2) (n1 * n2).
Notation "e '\\' n"
         := (aevalR e n)
            (at level 50, left associativity)
         : type_scope.
End aevalR_first_try.

Reserved Notation "e '\\' n" (at level 50, left associativity).
Inductive aevalR : aexp -> nat -> Prop :=
  | E_ANum : forall (n:nat),
      (ANum n) \\ n
  | E_APlus : forall (e1 e2: aexp) (n1 n2 : nat),
      (e1 \\ n1) -> (e2 \\ n2) -> (APlus e1 e2) \\ (n1 + n2)
  | E_AMinus : forall (e1 e2: aexp) (n1 n2 : nat),
      (e1 \\ n1) -> (e2 \\ n2) -> (AMinus e1 e2) \\ (n1 - n2)
  | E_AMult : forall (e1 e2: aexp) (n1 n2 : nat),
      (e1 \\ n1) -> (e2 \\ n2) -> (AMult e1 e2) \\ (n1 * n2)

  where "e '\\' n" := (aevalR e n) : type_scope.

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

Reserved Notation "e '||' n" (at level 50, left associativity).

Inductive bevalR : bexp -> bool -> Prop :=
| E_BTrue : BTrue || true
| E_BFalse : BFalse || false
| E_BEq : forall a1 a2 n1 n2,
aevalR a1 n1 -> aevalR a2 n2 -> BEq a1 a2 || beq_nat n1 n2
| E_BLe : forall a1 a2 n1 n2,
aevalR a1 n1 -> aevalR a2 n2 -> BLe a1 a2 || ble_nat n1 n2
| E_BNot : forall b p, b || p -> BNot b || negb p
| E_BAnd : forall b1 b2 p1 p2,
b1 || p1 -> b2 || p2 -> BAnd b1 b2 || andb p1 p2

where "e '||' n" := (bevalR e n) : type_scope.

Theorem aeval_iff_aevalR : forall a n,
  (a \\ n) <-> aeval a = n.
Proof.
split.
- intros. induction H;simpl.
  +  trivial.
  + rewrite IHaevalR1. rewrite IHaevalR2. trivial.
  + rewrite IHaevalR1. rewrite IHaevalR2. trivial.
  + rewrite IHaevalR1. rewrite IHaevalR2. trivial.
- intros. generalize dependent n. induction a;
  simpl; intros; subst.
  + apply E_ANum.
  + apply E_APlus. apply IHa1. reflexivity. apply IHa2. reflexivity.
  + apply E_AMinus. apply IHa1. reflexivity.
    apply IHa2. reflexivity.
  + apply E_AMult. apply IHa1. reflexivity. apply IHa2. reflexivity.
Qed.

Lemma beval_iff_bevalR : forall b bv,
  bevalR b bv <-> beval b = bv.
Proof.
intros.
split.
- intros. induction H;simpl.
  + reflexivity.
  + reflexivity.
  + induction H; simpl; induction H0; simpl;
try (reflexivity). generalize dependent n.
Admitted.
**)
Definition state := total_map nat.

Inductive aexp : Type :=
  | ANum : nat -> aexp
  | AId : string -> aexp (* <----- NEW *)
  | APlus : aexp -> aexp -> aexp
  | AMinus : aexp -> aexp -> aexp
  | AMult : aexp -> aexp -> aexp.

Definition W : string := "W".
Definition X : string := "X".
Definition Y : string := "Y".
Definition Z : string := "Z".

Inductive bexp : Type :=
  | BTrue : bexp
  | BFalse : bexp
  | BEq : aexp -> aexp -> bexp
  | BLe : aexp -> aexp -> bexp
  | BNot : bexp -> bexp
  | BAnd : bexp -> bexp -> bexp.

Coercion AId : string >-> aexp.
Coercion ANum : nat >-> aexp.
Definition bool_to_bexp (b: bool) : bexp :=
  if b then BTrue else BFalse.
Coercion bool_to_bexp : bool >-> bexp.

Bind Scope aexp_scope with aexp.
Infix "+" := APlus : aexp_scope.
Infix "-" := AMinus : aexp_scope.
Infix "*" := AMult : aexp_scope.
Bind Scope bexp_scope with bexp.
Infix "<=" := BLe : bexp_scope.
Infix "=" := BEq : bexp_scope.
Infix "&&" := BAnd : bexp_scope.
Notation "'!' b" := (BNot b) (at level 60) : bexp_scope.

Fixpoint aeval (st : state) (a : aexp) : nat :=
  match a with
  | ANum n => n
  | AId x => st x (* <----- NEW *)
  | APlus a1 a2 => (aeval st a1) + (aeval st a2)
  | AMinus a1 a2 => (aeval st a1) - (aeval st a2)
  | AMult a1 a2 => (aeval st a1) * (aeval st a2)
  end.

Fixpoint beval (st : state) (b : bexp) : bool :=
  match b with
  | BTrue => true
  | BFalse => false
  | BEq a1 a2 => beq_nat (aeval st a1) (aeval st a2)
  | BLe a1 a2 => leb (aeval st a1) (aeval st a2)
  | BNot b1 => negb (beval st b1)
  | BAnd b1 b2 => andb (beval st b1) (beval st b2)
  end.

Notation "{ a !-> x }" :=
  (t_update { !-> 0 } a x) (at level 0).
Notation "{ a !-> x ; b !-> y }" :=
  (t_update ({ a !-> x }) b y) (at level 0).
Notation "{ a !-> x ; b !-> y ; c !-> z }" :=
  (t_update ({ a !-> x ; b !-> y }) c z) (at level 0).
Notation "{ a !-> x ; b !-> y ; c !-> z ; d !-> t }" :=
    (t_update ({ a !-> x ; b !-> y ; c !-> z }) d t) (at level 0).
Notation "{ a !-> x ; b !-> y ; c !-> z ; d !-> t ; e !-> u }" :=
  (t_update ({ a !-> x ; b !-> y ; c !-> z ; d !-> t }) e u) (at level 0).
Notation "{ a !-> x ; b !-> y ; c !-> z ; d !-> t ; e !-> u ; f !-> v }" :=
  (t_update ({ a !-> x ; b !-> y ; c !-> z ; d !-> t ; e !-> u }) f v) (at level 0).

Inductive com : Type :=
  | CSkip : com
  | CAss : string -> aexp -> com
  | CSeq : com -> com -> com
  | CIf : bexp -> com -> com -> com
  | CWhile : bexp -> com -> com.

Bind Scope com_scope with com.
Notation "'SKIP'" :=
   CSkip : com_scope.
Notation "x '::=' a" :=
  (CAss x a) (at level 60) : com_scope.
Notation "c1 ;; c2" :=
  (CSeq c1 c2) (at level 80, right associativity) : com_scope.
Notation "'WHILE' b 'DO' c 'END'" :=
  (CWhile b c) (at level 80, right associativity) : com_scope.
Notation "'IFB' c1 'THEN' c2 'ELSE' c3 'FI'" :=
  (CIf c1 c2 c3) (at level 80, right associativity) : com_scope.

Open Scope com_scope.

Definition fact_in_coq : com :=
  Z ::= X;;
  Y ::= 1;;
  WHILE ! (Z = 0) DO
    Y ::= Y * Z;;
    Z ::= Z - 1
  END.

Definition plus2 : com :=
  X ::= X + 2.
Definition XtimesYinZ : com :=
  Z ::= X * Y.
Definition subtract_slowly_body : com :=
  Z ::= Z - 1 ;;
  X ::= X - 1.

Definition subtract_slowly : com :=
  WHILE ! (X = 0) DO
    subtract_slowly_body
  END.
Definition subtract_3_from_5_slowly : com :=
  X ::= 3 ;;
  Z ::= 5 ;;
  subtract_slowly.

Definition loop : com :=
  WHILE true DO
    SKIP
  END.

Fixpoint ceval_fun_no_while (st : state) (c : com)
                          : state :=
  match c with
    | SKIP =>
        st
    | x ::= a1 =>
        st & { x !-> (aeval st a1) }
    | c1 ;; c2 =>
        let st' := ceval_fun_no_while st c1 in
        ceval_fun_no_while st' c2
    | IFB b THEN c1 ELSE c2 FI =>
        if (beval st b)
          then ceval_fun_no_while st c1
          else ceval_fun_no_while st c2
    | WHILE b DO c END =>
        st (* bogus *)
  end.

Reserved Notation "c1 '/' st '\\' st'"
                  (at level 40, st at level 39).
Inductive ceval : com -> state -> state -> Prop :=
  | E_Skip : forall st,
      SKIP / st \\ st
  | E_Ass : forall st a1 n x,
      aeval st a1 = n ->
      (x ::= a1) / st \\ st & { x !-> n }
  | E_Seq : forall c1 c2 st st' st'',
      c1 / st \\ st' ->
      c2 / st' \\ st'' ->
      (c1 ;; c2) / st \\ st''
  | E_IfTrue : forall st st' b c1 c2,
      beval st b = true ->
      c1 / st \\ st' ->
      (IFB b THEN c1 ELSE c2 FI) / st \\ st'
  | E_IfFalse : forall st st' b c1 c2,
      beval st b = false ->
      c2 / st \\ st' ->
      (IFB b THEN c1 ELSE c2 FI) / st \\ st'
  | E_WhileFalse : forall b st c,
      beval st b = false ->
      (WHILE b DO c END) / st \\ st
  | E_WhileTrue : forall st st' st'' b c,
      beval st b = true ->
      c / st \\ st' ->
      (WHILE b DO c END) / st' \\ st'' ->
      (WHILE b DO c END) / st \\ st''

  where "c1 '/' st '\\' st'" := (ceval c1 st st').

Example ceval_example1:
    (X ::= 2;;
     IFB X <= 1
       THEN Y ::= 3
       ELSE Z ::= 4
     FI)
   / { !-> 0 } \\ { X !-> 2 ; Z !-> 4 }.
Proof.
apply E_Seq with { X !-> 2 }.
  -
    apply E_Ass. reflexivity.
  -
    apply E_IfFalse. simpl.
      reflexivity.
      apply E_Ass. simpl. reflexivity. Qed.

Example ceval_example2:
  (X ::= 0;; Y ::= 1;; Z ::= 2) / { !-> 0 } \\
  { X !-> 0 ; Y !-> 1 ; Z !-> 2 }.
Proof.
apply E_Seq with { X !-> 0}.
apply E_Ass. reflexivity.
apply E_Seq with { X !-> 0;Y !-> 1}.
apply E_Ass. reflexivity.
apply E_Ass. reflexivity.
Qed.

Theorem plus2_spec : forall st n st',
  st X = n ->
  plus2 / st \\ st' ->
  st' X = (n + 2).
Proof.
  intros st n st' HX Heval.
inversion Heval. subst. clear Heval. simpl.
  apply t_update_eq. Qed.

Definition empty_st := fun (_ : string) => 0.
(** do the advanced exercise **)


Module NatList.
  Inductive natprod : Type :=
    pair : nat -> nat -> natprod.

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

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

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

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

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

  Theorem surjective_pairing_stuck : forall (p : natprod),
                                       p = (fst p, snd p).
  Proof.
    intros p.
    destruct p.
    simpl.
    reflexivity.
  Qed.

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

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

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

  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' => n :: (repeat n count')
    end.

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

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

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

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

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

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

  Fixpoint nonzeros (l: natlist) : natlist :=
    match l with
      | nil => nil
      | 0 :: tl => nonzeros tl
      | hd :: tl => hd :: nonzeros tl
    end.
  Example test_nonzeros: nonzeros [0,1,0,2,3,0,0] = [1,2,3].
  Proof. reflexivity. Qed.

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

  Fixpoint odd (n : nat) : bool :=
    negb (even n).

  Fixpoint oddmembers (l: natlist) : natlist :=
    match l with
      | nil => nil
      | hd :: tl => match odd hd with
                      | false => oddmembers tl
                      | true => hd :: oddmembers tl
                    end
    end.

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

  Fixpoint countoddmembers (l:natlist) : nat :=
    match l with
      | nil => O
      | hd :: tl => match odd hd with
                      | false => countoddmembers tl
                      | true  => 1 + (countoddmembers tl)
                    end
    end.

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

  Fixpoint alternate (l1 l2: natlist) :natlist :=
    match l1, l2 with
      | nil, l2' => l2'
      | l1', nil => l1'
      | hd1 :: tl1, hd2 :: tl2  => hd1 :: hd2 :: (alternate tl1 tl2)
    end.

  Example test_alternate1: alternate [1,2,3] [4,5,6] = [1,4,2,5,3,6].
  Proof. reflexivity. Qed.
  Example test_alternate2: alternate [1] [4,5,6] = [1,4,5,6].
  Proof. reflexivity. Qed.
  Example test_alternate3: alternate [1,2,3] [4] = [1,4,2,3].
  Proof. reflexivity. Qed.
  Example test_alternate4: alternate [] [20,30] = [20,30].
  Proof. reflexivity. Qed.

  Definition bag := natlist.

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

  Fixpoint count (v: nat) (s: bag) : nat :=
    match s with
      | nil => 0
      | hd :: tl => match neq hd v with
                      | true  => 1 + (count v tl)
                      | false => (count v tl)
                    end
    end.

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

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

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

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

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

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

  Definition member (v: nat) (s: bag) : bool := nge (count v s) 1.

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

  Fixpoint remove_one (v: nat) (s: bag) : bag :=
    match s with
      | nil => nil
      | hd :: tl => match neq v hd with
                      | true  => tl
                      | false => hd :: remove_one v tl
                    end
    end.

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

  Fixpoint remove_all (v: nat) (s: bag) :bag :=
    match s with
      | nil => nil
      | hd :: tl => match neq v hd with
                      | true  => remove_all v tl
                      | false => hd :: remove_all v tl
                    end
    end.

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

  Fixpoint subset (s1: bag) (s2: bag) :bool :=
    match  s1, s2 with
      | nil, _  => true
      | _ , nil => false
      | s1', hd :: tl => subset (remove_one hd s1') tl
    end.

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

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

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

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

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

  Fixpoint snoc (l: natlist) (v: nat) :natlist :=
    match l with
      | nil => [v]
      | h :: t => h :: (snoc t v)
    end.

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

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

  Theorem length_snoc: forall n : nat, forall l: natlist,
                         length (snoc l n) = S (length l).
  Proof.
    intros n l.
    induction l as [| m l'].
    + reflexivity.
    + simpl. rewrite IHl'. reflexivity.
  Qed.

  Theorem rev_length_first: forall l :natlist,
                              length (rev l) = length l.
  Proof.
    intros l. induction l as [| n l'].
    + simpl. reflexivity.
    + simpl. rewrite length_snoc. rewrite IHl'. reflexivity.
  Qed.

  Theorem app_nil_end: forall l : natlist,
                         l ++ [] = l.
  Proof.
    intros l.
    induction l.
    + reflexivity.
    + simpl. rewrite IHl. reflexivity.
  Qed.

  Lemma snoc_rev: forall l: natlist, forall n: nat, rev (snoc l n) = n :: (rev l).
  Proof.
    intros l n.
    induction l.
    + reflexivity.
    + simpl.
      rewrite IHl.
      reflexivity.
  Qed.

  Theorem rev_involutive : forall l : natlist,
                             rev (rev l) = l.
  Proof.
    intros l.
    induction l.
    + reflexivity.
    + simpl.
      rewrite snoc_rev.
      rewrite IHl.
      reflexivity.
  Qed.

  Theorem rev_snoc: forall l: natlist, forall n: nat,
                      snoc (rev l) n = rev (n :: l).
  Proof.
    intros l n.
    induction l.
    + reflexivity.
    + reflexivity.
  Qed.

  Lemma snoc_app: forall n: nat, forall l1 l2: natlist,
                    l1 ++ snoc l2 n = snoc (l1 ++ l2) n.
  Proof.
    intros n l1 l2.
    induction l1.
    + reflexivity.
    + simpl. rewrite IHl1. reflexivity.
  Qed.

  Theorem distr_rev: forall l1 l2: natlist,
                       rev (l1 ++ l2) = (rev l2) ++ (rev l1).
  Proof.
    intros l1 l2.
    induction l1.
    + induction l2.
    - reflexivity.
    - simpl. rewrite app_nil_end. reflexivity.
      + simpl.
        rewrite IHl1.
        rewrite snoc_app.
        reflexivity.
  Qed.

  Theorem app_ass4: forall l1 l2 l3 l4: natlist,
                      l1 ++ (l2 ++ l3 ++ l4) = ((l1 ++ l2) ++ l3) ++ l4.
  Proof.
    intros l1 l2 l3 l4.
    rewrite app_ass.
    rewrite app_ass.
    reflexivity.

    Theorem snoc_append: forall (l: natlist) (n: nat),
                           snoc l n = l ++ [n].
    Proof.
      intros l n.
      induction l.
      + reflexivity.
      + simpl. rewrite IHl. reflexivity.
    Qed.

    Lemma nonzeros_length: forall l1 l2: natlist,
                             nonzeros (l1 ++ l2) = (nonzeros l1) ++ (nonzeros l2).
    Proof.
      intros l1 l2.
      induction l1.
      + reflexivity.
      + simpl. rewrite IHl1.
        induction l2.
      - simpl. rewrite app_nil_end.
        destruct n.
        * rewrite app_nil_end. reflexivity.
        * rewrite app_nil_end. reflexivity.
      - simpl. destruct n.
        *  reflexivity.
        * simpl. reflexivity.
    Qed.

    Theorem nil_rev: rev [] = [].
    Proof.
      reflexivity.
    Qed.

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

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

    Example test_index1 : index 0 [4,5,6,7] = Some 4.
    Proof. reflexivity. Qed.
    Example test_index2 : index 3 [4,5,6,7] = Some 7.
    Proof. reflexivity. Qed.
    Example test_index3 : index 10 [4,5,6,7] = None.
    Proof. reflexivity. Qed.

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

    Definition hd_opt (l: natlist): natoption :=
      match l with
        | nil => None
        | a :: _ => Some a
      end.

    Example test_hd_opt1 : hd_opt [] = None.
    Proof. reflexivity. Qed.
    Example test_hd_opt2 : hd_opt [1] = Some 1.
    Proof. reflexivity. Qed.
    Example test_hd_opt3 : hd_opt [5,6] = Some 5.
    Proof. reflexivity. Qed.

    Theorem option_elim_hd: forall (l: natlist) (default: nat),
                              hd default l = option_elim (hd_opt l) default.
    Proof.
      intros l default.
      destruct l.
      + simpl. reflexivity.
      + simpl. reflexivity.
    Qed.

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

    Fixpoint beq_natlist (l1 l2: natlist): bool :=
      match l1, l2 with
        | nil, nil => true
        | a::l1', b::l2' => match beq a b with
                              | true => beq_natlist l1' l2'
                              | false => false
                            end
        |  _, _ => false
      end.

    Example test_beq_natlist1 : (beq_natlist nil nil = true).
    Proof. reflexivity. Qed.
    Example test_beq_natlist2 : beq_natlist [1,2,3] [1,2,3] = true.
    Proof. reflexivity. Qed.
    Example test_beq_natlist3 : beq_natlist [1,2,3] [1,2,4] = false.
    Proof. reflexivity. Qed.

    Theorem beq_natlist_refl: forall l: natlist,
                                true = beq_natlist l l.
    Proof.
      intros l.
      induction l.
      + reflexivity.
      + simpl. rewrite IHl.
        induction n.
      - simpl. reflexivity.
      - simpl. rewrite <- IHn. reflexivity.
    Qed.

    Theorem silly1: forall (n m o p: nat),
                      n = m ->
                      [n, o] = [n, p] ->
                      [n, o] = [m, p].
    Proof.
      intros n m o p eq1 eq2.
      rewrite <- eq1.
      apply eq2.
    Qed.

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

    Theorem silly_ex:
      (forall n, even n = true -> odd (S n) = true) ->
      even 3 = true ->
      odd 4 = true.
    Proof.
      intros.
      apply H.
      apply H0.
    Qed.

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

    Theorem rev_exercise1: forall (l l': natlist),
                             l = rev l' ->
                             l' = rev l.
    Proof.
      intros l l' H.
      symmetry.
      rewrite H.
      apply rev_involutive.
    Qed.

    Theorem rev_ass': forall l1 l2 l3: natlist,
                        (l1 ++ l2) ++ l3 = l1 ++ l2 ++ l3.
      intros l1.
      induction l1.
      + reflexivity.
      + intros l2 l3.
        simpl.
        assert(H: (l1++l2)++l3 = l1++l2++l3).
        apply IHl1.
        rewrite H.
        reflexivity.
    Qed.

    Definition beq_nat (n m: nat): bool := neq n m.

    Theorem beq_nat_sym: forall (n m: nat),
                           beq_nat n m = beq_nat m n.
    Proof.
      intros n. induction n as [| n'].
      + destruct m. reflexivity.
        simpl. reflexivity.
      +  destruct m.
      - simpl. reflexivity.
      - simpl. apply IHn'.
    Qed.
  Qed.
End NatList.


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

From Coq
  Require Import Arith Lia List.

(** For lists *)

Arguments In {_}.
Arguments app {_}.

#[global] Infix "∈" := In (at level 70, no associativity).
#[global] Notation "⌊ l ⌋" := (length l) (at level 0, l at level 200, format "⌊ l ⌋").

#[global] Notation "P '⊆₁' Q" := (forall x, P x -> Q x) (at level 70, no associativity, format "P  ⊆₁  Q").
#[global] Notation "P '⊆₂' Q" := (forall x y, P x y -> Q x y) (at level 70, no associativity, format "P  ⊆₂  Q").

#[global] Notation "P '∪₁' Q" := (fun x => P x \/ Q x) (at level 1, no associativity, format "P ∪₁ Q").
#[global] Notation "P '∪₂' Q" := (fun x y => P x y \/ Q x y) (at level 1, no associativity, format "P ∪₂ Q").
#[global] Notation "P '∩₁' Q" := (fun x => P x /\ Q x) (at level 1, no associativity, format "P ∩₁ Q").
#[global] Notation "P '∩₂' Q" := (fun x y => P x y /\ Q x y) (at level 1, no associativity, format "P ∩₂ Q").

#[global] Notation "Q '∘' P" := (fun x z => exists y, P x y /\ Q y z) (at level 1, left associativity, format "Q ∘ P").

(** We use lia to avoid incompatibilities between Coq <= 8.15.2 and Coq >= 8.16
    DLW: I know this is a like a tank to crush a fly but it is more compatible
         than the other options *)
Definition plus_assoc n m p : n + (m + p) = n + m + p.      Proof. lia. Qed.
Definition le_plus_l n m : n <= n + m.                      Proof. lia. Qed.
Definition le_plus_r n m : m <= n + m.                      Proof. lia. Qed.
Definition le_trans n m p : n <= m -> m <= p -> n <= p.     Proof. lia. Qed.
Definition lt_le_trans n m p : n <= m -> m <= p -> n <= p.  Proof. lia. Qed.
Definition lt_0_Sn n : 0 < S n.                             Proof. lia. Qed.
Definition lt_n_S n m : n < m -> S n < S m.                 Proof. lia. Qed.
Definition lt_S_n n m : S n < S m -> n < m.                 Proof. lia. Qed.