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

Require Import List Arith Omega Permutation.

Require Import list_focus utils_tac.

Set Implicit Arguments.

Create HintDb length_db.

Tactic Notation "rew" "length" := autorewrite with length_db.
Tactic Notation "rew" "length" "in" hyp(H) := autorewrite with length_db in H.

Infix "~p" := (@Permutation _) (at level 70).

Fact Permutation_map_inv X Y (f : X -> Y) l m : map f l ~p m -> exists l', m = map f l' /\ l ~p l'.
Proof.
  assert (forall m1 m2, m1 ~p m2 -> forall l1, m1 = map f l1 -> exists l2, m2 = map f l2 /\ l1 ~p l2) as L.
  + induction 1 as [ | y m1 m2 H1 IH1 | y1 y2 m1 | m1 m2 m3 H1 IH1 H2 IH2 ].
    * intros [ | ]; exists nil; auto; discriminate.
    * intros [ | x l1 ]; simpl; try discriminate.
      intros H2; injection H2; clear H2; intros H2 H3; subst y.
      destruct (IH1 _ H2) as (l2 & ? & ?).
      exists (x::l2); simpl; subst; auto.
    * intros [ | x2 [ | x1 l1 ] ]; try discriminate; simpl.
      intros H2; injection H2; clear H2; intros H1 H2 H3; subst.
      exists (x1::x2::l1); simpl; split; auto; constructor.
    * intros l1 H3.
      destruct IH1 with (1 := H3) as (l2 & H4 & H5).
      destruct IH2 with (1 := H4) as (l3 & H6 & H7).
      exists l3; split; auto.
      constructor 4 with l2; auto.
  + intros H1; apply L with (2 := eq_refl); auto.
Qed.

Section length.

  Variable X : Type.

  Implicit Type l : list X.

  Fact length_nil : length (@nil X) = 0.
  Proof. auto. Qed.

  Fact length_cons x l : length (x::l) = S (length l).
  Proof. auto. Qed.

End length.

Hint Rewrite length_nil length_cons app_length map_length rev_length : length_db.

Section list_an.

  Fixpoint list_an a n :=
    match n with
      | 0   => nil
      | S n => a::list_an (S a) n
    end.

  Fact list_an_S a n : list_an a (S n) = a::list_an (S a) n.
  Proof. auto. Qed.

  Fact list_an_plus a n m : list_an a (n+m) = list_an a n ++ list_an (n+a) m.
  Proof.
    revert a; induction n; intros a; simpl; auto.
    rewrite IHn; do 3 f_equal; omega.
  Qed.

  Fact list_an_length a n : length (list_an a n) = n.
  Proof.
    revert a; induction n; intro; simpl; f_equal; auto.
  Qed.

  Fact list_an_spec a n m : In m (list_an a n) <-> a <= m < a+n.
  Proof.
    revert a; induction n as [ | n IHn ]; simpl; intros a; [ | rewrite IHn ]; omega.
  Qed.

  Fact map_S_list_an a n : map S (list_an a n) = list_an (S a) n.
  Proof. revert a; induction n; simpl; intro; f_equal; auto. Qed.

  Fact list_an_app_inv a n l r : list_an a n = l++r -> l = list_an a (length l) /\ r = list_an (a+length l) (length r).
  Proof.
    revert a l r; induction n as [ | n IHn ]; intros a l r; simpl.
    + destruct l; destruct r; intros; auto; discriminate.
    + destruct l as [ | x l ]; simpl; intros H1.
      * split; auto.
        rewrite <- H1; simpl; rewrite Nat.add_0_r, list_an_length; auto.
      * injection H1; clear H1; intros H1 H0.
        apply IHn in H1; destruct H1; split; f_equal; auto.
        rewrite H1 at 1; f_equal; omega.
  Qed.

End list_an.

Hint Rewrite list_an_length : length_db.

Section list_injective.

  Variable X : Type.

  Definition list_injective (ll : list X) :=  forall l a m b r, ll = l ++ a :: m ++ b :: r -> a <> b.

  Fact in_list_injective_0 : list_injective nil.
  Proof. intros [] ? ? ? ? ?; discriminate. Qed.

  Fact in_list_injective_1 x ll : ~ In x ll -> list_injective ll -> list_injective (x::ll).
  Proof.
    intros H1 H2 l a m b r H3.
    destruct l as [ | u l ].
    inversion H3; subst.
    destruct m as [ | v m ].
    contradict H1; subst; simpl; auto.
    contradict H1; subst; simpl; right; apply in_or_app; right; left; auto.
    inversion H3; subst.
    apply (H2 l _ m _ r); auto.
  Qed.

  Fact list_injective_inv x ll : list_injective (x::ll) -> ~ In x ll /\ list_injective ll.
  Proof.
    split.
    intros H1; apply in_split in H1; destruct H1 as (l & r & ?); subst.
    apply (H nil x l x r); auto.
    intros l a m b r ?; apply (H (x::l) a m b r); subst; solve list eq.
  Qed.

  Variable P : list X -> Type.

  Hypothesis (HP0 : P nil).
  Hypothesis (HP1 : forall x l, ~ In x l -> P l -> P (x::l)).

  Theorem list_injective_rect l : list_injective l -> P l.
  Proof.
    induction l as [ [ | x l ] IHl ] using (measure_rect (@length _)).
    intro; apply HP0.
    intros; apply HP1.
    apply list_injective_inv, H.
    apply IHl; simpl; auto.
    apply list_injective_inv with (1 := H).
  Qed.

End list_injective.

Fact list_injective_map X Y (f : X -> Y) ll :
       (forall x y, f x = f y -> x = y) -> list_injective ll -> list_injective (map f ll).
Proof.
  intros Hf.
  induction 1 as [ | x l Hl IHl ] using list_injective_rect.
  apply in_list_injective_0.
  simpl; apply in_list_injective_1; auto.
  contradict Hl.
  apply in_map_iff in Hl.
  destruct Hl as (y & Hl & ?).
  apply Hf in Hl; subst; auto.
Qed.

Section iter.

  Variable (X : Type) (f : X -> X).

  Fixpoint iter x n :=
    match n with
      | 0   => x
      | S n => iter (f x) n
    end.

  Fact iter_plus x a b : iter x (a+b) = iter (iter x a) b.
  Proof. revert x; induction a; intros x; simpl; auto. Qed.

End iter.

Fixpoint list_repeat X (x : X) n :=
  match n with
    | 0   => nil
    | S n => x::list_repeat x n
  end.

Fact list_repeat_plus X x a b : @list_repeat X x (a+b) = list_repeat x a ++ list_repeat x b.
Proof. induction a; simpl; f_equal; auto. Qed.

Fact list_repeat_length X x n : length (@list_repeat X x n) = n.
Proof. induction n; simpl; f_equal; auto. Qed.

Fact In_list_repeat X (x y : X) n : In y (list_repeat x n) -> x = y /\ 0 < n.
Proof.
  induction n; simpl; intros [].
  split; auto; omega.
  split; try omega; apply IHn; auto.
Qed.

Fact map_list_repeat X Y f x n : @map X Y f (list_repeat x n) = list_repeat (f x) n.
Proof. induction n; simpl; f_equal; auto. Qed.

Fact map_cst_repeat X Y (y : Y) ll : map (fun _ : X => y) ll = list_repeat y (length ll).
Proof. induction ll; simpl; f_equal; auto. Qed.

Fact map_cst_snoc X Y (y : Y) ll mm : y :: map (fun _ : X => y) ll++mm = map (fun _ => y) ll ++ y::mm.
Proof. induction ll; simpl; f_equal; auto. Qed.

Fact map_cst_rev  X Y (y : Y) ll : map (fun _ : X => y) (rev ll) = map (fun _ => y) ll.
Proof. do 2 rewrite map_cst_repeat; rewrite rev_length; auto. Qed.

Fact In_perm X (x : X) l : In x l -> exists m, x::m ~p l.
Proof.
  intros H; apply in_split in H.
  destruct H as (m & k & ?); subst.
  exists (m++k).
  apply Permutation_cons_app; auto.
Qed.

Fact list_app_eq_inv X (l1 l2 r1 r2 : list X) :
       l1++r1 = l2++r2 -> { m | l1++m = l2 /\ r1 = m++r2 }
                        + { m | l2++m = l1 /\ r2 = m++r1 }.
Proof.
  revert l2 r1 r2; induction l1 as [ | x l1 IH ].
  intros; left; exists l2; auto.
  intros [ | y l2 ] r1 r2; simpl; intros H.
  right; exists (x::l1); auto.
  inversion H.
  destruct (IH l2 r1 r2) as [ (m & Hm) | (m & Hm) ]; auto;
    [ left | right ]; exists m; split; f_equal; tauto.
Qed.

Fact list_app_cons_eq_inv X (l1 l2 r1 r2 : list X) x :
       l1++r1 = l2++x::r2 -> { m | l1++m = l2 /\ r1 = m++x::r2 }
                           + { m | l2++x::m = l1 /\ r2 = m++r1 }.
Proof.
  intros H.
  apply list_app_eq_inv in H.
  destruct H as [ H | (m & H1 & H2) ]; auto.
  destruct m as [ | y m ].
  left; exists nil; simpl in *; split; auto.
  revert H1; do 2 rewrite <- app_nil_end; auto.
  inversion H2; subst.
  right; exists m; auto.
Qed.

Fact list_app_inj X (l1 l2 r1 r2 : list X) : length l1 = length l2 -> l1++r1 = l2++r2 -> l1 = l2 /\ r1 = r2.
Proof.
  revert l2; induction l1 as [ | x l1 IH ]; intros [ | y l2 ]; try discriminate.
  simpl; auto.
  intros H1 H2; inversion H1; inversion H2.
  apply IH in H4; auto.
  split; f_equal; tauto.
Qed.

Fact list_split_length X (ll : list X) k : k <= length ll -> { l : _ & { r | ll = l++r /\ length l = k } }.
Proof.
  revert k; induction ll as [ | x ll IHll ]; intros k.
  exists nil, nil; split; simpl in * |- *; auto; omega.
  destruct k as [ | k ]; intros Hk.
  exists nil, (x::ll); simpl; split; auto.
  destruct (IHll k) as (l & r & H1 & H2).
  simpl in Hk; omega.
  exists (x::l), r; split; simpl; auto; f_equal; auto.
Qed.

Fact list_pick X (ll : list X) k : k < length ll -> { x : _ & { l : _ & { r | ll = l++x::r /\ length l = k } } }.
Proof.
  revert k; induction ll as [ | x ll IHll ]; intros k.
  simpl; omega.
  destruct k as [ | k ]; intros H.
  exists x, nil, ll; simpl; auto.
  simpl in H.
  destruct IHll with (k := k) as (y & l & r & ? & ?); try omega.
  exists y, (x::l), r; subst; simpl; split; auto.
Qed.

Fact list_split_middle X l1 (x1 : X) r1 l2 x2 r2 :
       ~ In x1 l2 -> ~ In x2 l1 -> l1++x1::r1 = l2++x2::r2 -> l1 = l2 /\ x1 = x2 /\ r1 = r2.
Proof.
  intros H1 H2 H.
  apply list_app_eq_inv in H.
  destruct H as [ (m & H3 & H4) | (m & H3 & H4) ]; destruct m.
  inversion H4; subst; rewrite <- app_nil_end; auto.
  inversion H4; subst; destruct H1; apply in_or_app; right; left; auto.
  inversion H4; subst; rewrite <- app_nil_end; auto.
  inversion H4; subst; destruct H2; apply in_or_app; right; left; auto.
Qed.

Section flat_map.

  Variable (X Y : Type) (f : X -> list Y).

  Fact flat_map_app l1 l2 : flat_map f (l1++l2) = flat_map f l1 ++ flat_map f l2.
  Proof.
    induction l1; simpl; auto; solve list eq; f_equal; auto.
  Qed.

  Fact flat_map_app_inv l r1 y r2 : flat_map f l = r1++y::r2 -> exists l1 m1 x m2 l2, l = l1++x::l2 /\ f x = m1++y::m2
                                                                  /\ r1 = flat_map f l1++m1 /\ r2 = m2++flat_map f l2.
  Proof.
    revert r1 y r2.
    induction l as [ | x l IHl ]; intros r1 y r2 H.
    + destruct r1; discriminate.
    + simpl in H.
      apply list_app_cons_eq_inv in H.
      destruct H as [ (m & Hm1 & Hm2) | (m & Hm1 & Hm2) ].
      - apply IHl in Hm2.
        destruct Hm2 as (l1 & m1 & x' & m2 & l2 & G1 & G2 & G3 & G4); subst.
        exists (x::l1), m1, x', m2, l2; simpl; repeat (split; auto).
        rewrite app_ass; auto.
      - exists nil, r1, x, m, l; auto.
  Qed.

End flat_map.

Definition prefix X (l ll : list X) := exists r, ll = l++r.

Infix "<p" := (@prefix _) (at level 70, no associativity).

Section prefix. (* as an inductive predicate *)

  Variable X : Type.

  Implicit Types (l ll : list X).

  Fact in_prefix_0 ll : nil <p ll.
  Proof.
    exists ll; auto.
  Qed.

  Fact in_prefix_1 x l ll : l <p ll -> x::l <p x::ll.
  Proof.
    intros (r & ?); subst; exists r; auto.
  Qed.

  Fact prefix_length l m : l <p m -> length l <= length m.
  Proof. intros (? & ?); subst; rew length; omega. Qed.

  Fact prefix_app_lft l r1 r2 : r1 <p r2 -> l++r1 <p l++r2.
  Proof.
    intros (a & ?); subst.
    exists a; rewrite app_ass; auto.
  Qed.

  Fact prefix_inv x y l ll : x::l <p y::ll -> x = y /\ l <p ll.
  Proof.
    intros (r & Hr).
    inversion Hr; split; auto.
    exists r; auto.
  Qed.

  Fact prefix_list_inv l r rr : l++r <p l++rr -> r <p rr.
  Proof.
    induction l as [ | x l IHl ]; simpl; auto.
    intros H; apply prefix_inv, proj2, IHl in H; auto.
  Qed.

  Fact prefix_refl l : l <p l.
  Proof. exists nil; rewrite <- app_nil_end; auto. Qed.

  Fact prefix_trans l1 l2 l3 : l1 <p l2 -> l2 <p l3 -> l1 <p l3.
  Proof. intros (m1 & H1) (m2 & H2); subst; exists (m1++m2); solve list eq. Qed.

  Section prefix_rect.

    Variables (P : list X -> list X -> Type)
              (HP0 : forall ll, P nil ll)
              (HP1 : forall x l ll, l <p ll -> P l ll -> P (x::l) (x::ll)).

    Definition prefix_rect l ll : prefix l ll -> P l ll.
    Proof.
      revert l; induction ll as [ | x ll IHll ]; intros l H.

      replace l with (nil : list X).
      apply HP0.
      destruct H as (r & Hr).
      destruct l; auto; discriminate.

      destruct l as [ | y l ].
      apply HP0.
      apply prefix_inv in H.
      destruct H as (? & E); subst y.
      apply HP1; [ | apply IHll ]; trivial.
    Qed.

  End prefix_rect.

  Fact prefix_app_inv l1 l2 r1 r2 : l1++l2 <p r1++r2 -> { l1 <p r1 } + { r1 <p l1 }.
  Proof.
    revert l2 r1 r2; induction l1 as [ | x l1 IH ].
    left; apply in_prefix_0.
    intros l2 [ | y r1 ] r2.
    right; apply in_prefix_0.
    simpl; intros H; apply prefix_inv in H.
    destruct H as (E & H); subst y.
    destruct IH with (1 := H); [ left | right ];
      apply in_prefix_1; auto.
  Qed.

End prefix.

Definition prefix_spec X (l ll : list X) : l <p ll -> { r | ll = l ++ r }.
Proof.
  induction 1 as [ ll | x l ll _ (r & Hr) ] using prefix_rect.
  exists ll; trivial.
  exists r; simpl; f_equal; auto.
Qed.

Fact prefix_app_lft_inv X (l1 l2 m : list X) : l1++l2 <p m -> { m2 | m = l1++m2 /\ l2 <p m2 }.
Proof.
  intros H.
  apply prefix_spec in H.
  destruct H as (r & H).
  exists (l2++r); simpl.
  solve list eq in H; split; auto.
  exists r; auto.
Qed.

Section list_assoc.

  Variables (X Y : Type) (eq_X_dec : eqdec X).

  Fixpoint list_assoc x l : option Y :=
    match l with
      | nil  => None
      | (y,a)::l => if eq_X_dec x y then Some a else list_assoc x l
    end.

  Fact list_assoc_eq x y l x' : x = x' -> list_assoc x' ((x,y)::l) = Some y.
  Proof.
    intros []; simpl.
    destruct (eq_X_dec x x) as [ | [] ]; auto.
  Qed.

  Fact list_assoc_neq x y l x' : x <> x' -> list_assoc x' ((x,y)::l) = list_assoc x' l.
  Proof.
    intros H; simpl.
    destruct (eq_X_dec x' x) as [ | ]; auto.
    destruct H; auto.
  Qed.

  Fact list_assoc_In x l :
    match list_assoc x l with
      | None   => ~ In x (map fst l)
      | Some y => In (x,y) l
    end.
  Proof.
    induction l as  [ | (x',y) l IHl ]; simpl; auto.
    destruct (eq_X_dec x x'); subst; auto.
    destruct (list_assoc x l); auto.
    intros [ ? | ]; subst; tauto.
  Qed.

  Fact In_list_assoc x l : In x (map fst l) -> { y | list_assoc x l = Some y /\ In (x,y) l }.
  Proof.
    intros H.
    generalize (list_assoc_In x l).
    destruct (list_assoc x l) as [ y | ].
    exists y; auto.
    tauto.
  Qed.

  Fact not_In_list_assoc x l : ~ In x (map fst l) -> list_assoc x l = None.
  Proof.
    intros H.
    generalize (list_assoc_In x l).
    destruct (list_assoc x l) as [ y | ]; auto.
    intros H1; contradict H.
    apply in_map_iff.
    exists (x,y); simpl; auto.
  Qed.

  Fact list_assoc_app x ll mm : list_assoc x (ll++mm)
                              = match list_assoc x ll with
                                  | None   => list_assoc x mm
                                  | Some y => Some y
                                end.
  Proof.
    induction ll as [ | (x',?) ]; simpl; auto.
    destruct (eq_X_dec x x'); auto.
  Qed.

End list_assoc.

Section list_first_dec.

  Variable (X : Type) (P : X -> Prop) (Pdec : forall x, { P x } + { ~ P x }).

  Theorem list_choose_dec ll : { l : _ & { x : _ & { r | ll = l++x::r /\ P x /\ forall y, In y l -> ~ P y } } }
                             + { forall x, In x ll -> ~ P x }.
  Proof.
    induction ll as [ | a ll IH ];
      [ | destruct (Pdec a) as [ Ha | Ha ]; [ | destruct IH as [ (l & x & r & H1 & H2 & H3) | H ]] ].
    * right; intros _ [].
    * left; exists nil, a, ll; repeat split; auto.
    * left; exists (a::l), x, r; repeat split; subst; auto.
      intros ? [ | ]; subst; auto.
    * right; intros ? [ | ]; subst; auto.
  Qed.

  Theorem list_first_dec a ll : P a -> In a ll -> { l : _ & { x : _ & { r | ll = l++x::r /\ P x /\ forall y, In y l -> ~ P y } } }.
  Proof.
    intros H1 H2.
    destruct (list_choose_dec ll) as [ H | H ]; trivial.
    destruct (H _ H2 H1).
  Qed.

End list_first_dec.

Section map.

  Variable (X Y : Type) (f : X -> Y).

  Fact map_cons_inv ll y m : map f ll = y::m -> { x : _ & { l | ll = x::l /\ f x = y /\ map f l = m } }.
  Proof.
    destruct ll as [ | x l ]; try discriminate; simpl.
    intros H; inversion H; subst; exists x, l; auto.
  Qed.

  Fact map_app_inv ll m n : map f ll = m++n -> { l : _  & { r | ll = l++r /\ m = map f l /\ n = map f r } }.
  Proof.
    revert m n; induction ll as [ | x ll IH ]; intros m n H.
    * destruct m; destruct n; try discriminate; exists nil, nil; auto.
    * destruct m as [ | y m ]; simpl in H.
      + exists nil, (x::ll); auto.
      + inversion H; subst y.
        destruct IH with (1 := H2) as (l & r & H3 & H4 & H5); subst.
        exists (x::l), r; auto.
  Qed.

  Fact map_middle_inv ll m y n : map f ll = m++y::n -> { l : _ & { x : _ & { r | ll = l++x::r /\ map f l = m /\ f x = y /\ map f r = n } } }.
  Proof.
    intros H.
    destruct map_app_inv with (1 := H) as (l & r & H1 & H2 & H3).
    symmetry in H3.
    destruct map_cons_inv with (1 := H3) as (x & r' & H4 & H5 & H6); subst.
    exists l, x, r'; auto.
  Qed.

End map.

Fact Forall2_mono X Y (R S : X -> Y -> Prop) :
         (forall x y, R x y -> S x y) -> forall l m, Forall2 R l m -> Forall2 S l m.
Proof.
  induction 2; constructor; auto.
Qed.

Fact Forall2_nil_inv_l X Y R m : @Forall2 X Y R nil m -> m = nil.
Proof.
  inversion_clear 1; reflexivity.
Qed.

Fact Forall2_nil_inv_r X Y R m : @Forall2 X Y R m nil -> m = nil.
Proof.
  inversion_clear 1; reflexivity.
Qed.

Fact Forall2_cons_inv X Y R x l y m : @Forall2 X Y R (x::l) (y::m) <-> R x y /\ Forall2 R l m.
Proof.
  split.
  inversion_clear 1; auto.
  intros []; constructor; auto.
Qed.

Fact Forall2_app_inv_l X Y R l1 l2 m :
    @Forall2 X Y R (l1++l2) m -> { m1 : _ & { m2 | Forall2 R l1 m1 /\ Forall2 R l2 m2 /\ m = m1++m2 } }.
Proof.
  revert l2 m;
  induction l1 as [ | x l1 IH ]; simpl; intros l2 m H.
  exists nil, m; repeat split; auto.
  destruct m as [ | y m ].
  apply Forall2_nil_inv_r in H; discriminate H.
  apply Forall2_cons_inv in H; destruct H as [ H1 H2 ].
  apply IH in H2.
  destruct H2 as (m1 & m2 & H2 & H3 & H4); subst m.
  exists (y::m1), m2; repeat split; auto.
Qed.

Fact Forall2_app_inv_r X Y R l m1 m2 :
    @Forall2 X Y R l (m1++m2) -> { l1 : _ & { l2 | Forall2 R l1 m1 /\ Forall2 R l2 m2 /\ l = l1++l2 } }.
Proof.
  revert m2 l;
  induction m1 as [ | y m1 IH ]; simpl; intros m2 l H.
  exists nil, l; repeat split; auto.
  destruct l as [ | x l ].
  apply Forall2_nil_inv_l in H; discriminate H.
  apply Forall2_cons_inv in H; destruct H as [ H1 H2 ].
  apply IH in H2.
  destruct H2 as (l1 & l2 & H2 & H3 & H4); subst l.
  exists (x::l1), l2; repeat split; auto.
Qed.

Fact Forall2_cons_inv_l X Y R a ll mm :
      @Forall2 X Y R (a::ll) mm
   -> { b : _ & { mm' | R a b /\ mm = b::mm' /\ Forall2 R ll mm' } }.
Proof.
  intros H.
  apply Forall2_app_inv_l with (l1 := a::nil) (l2 := ll) in H.
  destruct H as (l & mm' & H1 & H2 & H3).
  destruct l as [ | y l ].
  exfalso; inversion H1.
  apply Forall2_cons_inv in H1.
  destruct H1 as [ H1 H4 ].
  apply Forall2_nil_inv_l in H4; subst l.
  exists y, mm'; auto.
Qed.

Fact Forall2_cons_inv_r X Y R b ll mm :
      @Forall2 X Y R ll (b::mm)
   -> { a : _ & { ll' | R a b /\ ll = a::ll' /\ Forall2 R ll' mm } }.
Proof.
  intros H.
  apply Forall2_app_inv_r with (m1 := b::nil) (m2 := mm) in H.
  destruct H as (l & ll' & H1 & H2 & H3).
  destruct l as [ | x l  ].
  exfalso; inversion H1.
  apply Forall2_cons_inv in H1.
  destruct H1 as [ H1 H4 ].
  apply Forall2_nil_inv_r in H4; subst l.
  exists x, ll'; auto.
Qed.

Fact Forall2_map_left X Y Z (R : Y -> X -> Prop) (f : Z -> Y) ll mm : Forall2 R (map f ll) mm <-> Forall2 (fun x y => R (f x) y) ll mm.
Proof.
  split.
  revert mm.
  induction ll; intros [ | y mm ] H; simpl in H; auto; try (inversion H; fail).
  apply Forall2_cons_inv in H; constructor.
  tauto.
  apply IHll; tauto.
  induction 1; constructor; auto.
Qed.

Fact Forall2_map_right X Y Z (R : Y -> X -> Prop) (f : Z -> X) mm ll : Forall2 R mm (map f ll) <-> Forall2 (fun y x => R y (f x)) mm ll.
Proof.
  split.
  revert mm.
  induction ll; intros [ | y mm ] H; simpl in H; auto; try (inversion H; fail).
  apply Forall2_cons_inv in H; constructor.
  tauto.
  apply IHll; tauto.
  induction 1; constructor; auto.
Qed.

Fact Forall2_map_both X Y X' Y' (R : X -> Y -> Prop) (f : X' -> X) (g : Y' -> Y) ll mm : Forall2 R (map f ll) (map g mm) <-> Forall2 (fun x y => R (f x) (g y)) ll mm.
Proof.
  rewrite Forall2_map_left, Forall2_map_right; split; auto.
Qed.

Fact Forall2_Forall X (R : X -> X -> Prop) ll : Forall2 R ll ll <-> Forall (fun x => R x x) ll.
Proof.
  split.
  induction ll as [ | x ll ]; inversion_clear 1; auto.
  induction 1; auto.
Qed.

Fact Forall_app X (P : X -> Prop) ll mm : Forall P (ll++mm) <-> Forall P ll /\ Forall P mm.
Proof.
  repeat rewrite Forall_forall.
  split.
  firstorder.
  intros (H1 & H2) x Hx.
  apply in_app_or in Hx; firstorder.
Qed.

Fact Forall_cons_inv X (P : X -> Prop) x ll : Forall P (x::ll) <-> P x /\ Forall P ll.
Proof.
  split.
  + inversion 1; auto.
  + constructor; tauto.
Qed.

Fact Forall_rev X (P : X -> Prop) ll : Forall P ll -> Forall P (rev ll).
Proof.
  induction 1 as [ | x ll Hll IH ].
  constructor.
  simpl.
  apply Forall_app; split; auto.
Qed.

Fact Forall_map X Y (f : X -> Y) (P : Y -> Prop) ll : Forall P (map f ll) <-> Forall (fun x => P (f x)) ll.
Proof.
  split.
  + induction ll; simpl; try rewrite Forall_cons_inv; constructor; tauto.
  + induction 1; simpl; constructor; auto.
Qed.

Fact Forall_impl X (P Q : X -> Prop) ll : (forall x, In x ll -> P x -> Q x) -> Forall P ll -> Forall Q ll.
Proof.
  intros H; induction 1 as [ | x ll Hx Hll IH ]; constructor.
  + apply H; simpl; auto.
  + apply IH; intros ? ?; apply H; simpl; auto.
Qed.

Fact Forall_filter X (P : X -> Prop) (f : X -> bool) ll : Forall P ll -> Forall P (filter f ll).
Proof. induction 1; simpl; auto; destruct (f x); auto. Qed.


Require Import List.
Import ListNotations.

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

Eval compute in alternate [1] [2].
Eval compute in alternate [1; 3; 5] [2; 4; 6].

Inductive alt : list nat -> list nat -> list nat -> Prop :=
| alt_nil :
    forall l, alt [] l l
| alt_step :
    forall a l t1 t2,
    alt l t1 t2 ->
    alt (a :: t1) l (a :: t2).

Lemma alt_one : alt [] [1] [1].
Proof.
apply alt_nil.
Qed.

Lemma alt_123456 : alt [1; 3; 5] [2; 4; 6] [1; 2; 3; 4; 5; 6].
Proof.
apply alt_step.
apply alt_step.
apply alt_step.
apply alt_step.
apply alt_step.
apply alt_step.
apply alt_nil.
Qed.

Print list_ind.

Lemma alt_alternate :
  forall l1 l2 l3, alt l1 l2 l3 -> alternate l1 l2 = l3.
Proof.
induction l1; intros.
- inversion H.
  subst.
  simpl.
  reflexivity.
- destruct l2; simpl.
  * inversion H.
    inversion H4.
    reflexivity.
  * inversion H.
    inversion H4.
    subst.
    apply IHl1 in H9.
    rewrite H9.
    reflexivity.
Qed.

Lemma alternate_alt :
  forall l1 l2 l3, alternate l1 l2 = l3 -> alt l1 l2 l3.
Proof.
induction l1; simpl; intros.
- rewrite H. apply alt_nil.
- destruct l2; subst; apply alt_step; try apply alt_nil.
  apply alt_step. apply IHl1. reflexivity.
Qed.

Extraction Language Ocaml.

Require Import ExtrOcamlBasic.
Require Import ExtrOcamlNatInt.

Extraction "alternate.ml" alternate.

(*
Fixpoint alternate' (l1 l2 : list nat) : list nat :=
match l1 with
| [] => l2
| h1 :: t1 => h1 :: alternate' l2 t1
end.
*)

Require Program.Wf.
Require Import Sorting.Permutation.

Program Fixpoint alternate' (l1 l2 : list nat)
 { measure (length (l1 ++ l2)) } : { l | alt l1 l2 l } :=
match l1 with
| [] => l2
| h1 :: t1 => h1 :: alternate' l2 t1
end.

Next Obligation.
Proof.
apply alt_nil.
Defined.

Next Obligation.
Proof.
simpl.
assert (H_l: length (l2 ++ t1) = length (t1 ++ l2)).
  apply Permutation_length.
  apply Permutation_app_swap.
rewrite H_l.
auto with arith.
Defined.

Next Obligation.
case alternate'.
intros.
simpl.
apply alt_step.
assumption.
Defined.

Eval compute in proj1_sig (alternate' [1] [2]).


From Coq Require Import Arith.

Fixpoint sum_simple (f : nat -> nat) (n : nat) : nat :=
  match n with
  | 0 => f 0
  | S m => f n + sum_simple f m
end.

Fixpoint sum_aux (a : nat) (f : nat -> nat) (n : nat) : nat :=
  match n with
  | 0 => f 0 + a
  | S m => sum_aux (f n + a) f m
end.

Definition sum_tail := sum_aux 0.

Lemma sum_aux_rec: forall a f n,
  sum_aux a f n = a + sum_aux 0 f n.
Proof.
  intros. generalize dependent a.
  induction n.
  - intros. simpl. rewrite Nat.add_0_r. rewrite Nat.add_comm. reflexivity.
  - intros. simpl. rewrite IHn. symmetry. rewrite IHn.
    rewrite Nat.add_0_r. rewrite Nat.add_assoc. rewrite Nat.add_comm with (a) (f (S n)).
    reflexivity.
Qed.


(* 4 Inductive Predicates *)

Require Import Cpdt.CpdtTactics.
Require Import List.

Print unit.

Print True.

(* 4.1 Propositional Logic *)

Section Propositional.
  Variables P Q R : Prop.

  Theorem obvious :
    True.
      apply I.
  Qed.

  Theorem obvious' :
    True.
      constructor.
  Qed.

  Print False.

  Theorem False_imp : False -> 2 + 2 = 5.
                                 destruct 1.
  Qed.

  Theorem ariyh_neq : 2 + 2 = 5 -> 9 + 9 = 835.
                                     intro.
                                     elimtype False.
                                     crush.
  Qed.

  Print not.

  Theorem arith_neq' : ~(2 + 2 = 5).
                         unfold not.
                         crush.
  Qed.

  Print and.

  Theorem and_comm : P /\ Q -> Q /\ P .
                                 destruct 1.
                                 split.
                                 assumption.
                                 assumption.
  Qed.

  Print or.

  Theorem or_comm : P \/ Q -> Q \/ P.
                                destruct 1.
                                right.
                                assumption.
                                left.
                                assumption.
  Qed.

  Theorem or_comm' : P \/ Q -> Q \/ P.
                                 tauto.
  Qed.

  Theorem arith_comm : forall ls1 ls2 : list nat ,
      length ls1 = length ls2 \/ length ls1 + length ls2 = 6
      -> length (ls1 ++ ls2) = 6 \/ length ls1 = length ls2.
                                      intuition.
                                      rewrite app_length.
                                      tauto.
  Qed.

  Theorem arith_comm' : forall ls1 ls2 : list nat ,
      length ls1 = length ls2 \/ length ls1 + length ls2 = 6
      -> length (ls1 ++ ls2) = 6 \/ length ls1 = length ls2.
                                      Hint Rewrite app_length.
                                      crush.
  Qed.

End Propositional.

(* 4.2 What Does It Mean to Be Constructive? *)

(* 4.3 First-Order Logic *)

Print ex.

Theorem exist1 : exists x : nat , x + 1 = 2.
                                    exists 1.
                                    reflexivity.
Qed.

Theorem exist2 : forall n m : nat , (exists x : nat , n + x = m) -> n <= m.
                                                                      destruct 1.
                                                                      crush.
Qed.

(* 4.4 Predicates with Implicit Equality *)

Inductive isZero : nat -> Prop :=
| IsZero : isZero 0
.

Theorem isZero_zero : isZero 0.
                        constructor.
Qed.

(*
This can be interpreted as a Judgement, or natural deduction rule.

-------- (IsZero)
isZero 0

 *)

Print eq.

(*
Another way of stating that definition is: equality is defined
as the least reflexive relation.
*)

Theorem isZero_plus : forall n m : nat , isZero m -> n + m = n.
                                                       destruct 1.
                                                       crush.
Qed.

Theorem isZero_contra : isZero 1 -> False.
                          destruct 1.
                          Undo.
                          inversion 1.
Qed.

Theorem isZero_contra' : isZero 1 -> 2 + 2 = 5.
                                       destruct 1.
Abort.

Check isZero_ind.

(* 4.5 Recursive Predicates *)

Inductive even : nat -> Prop :=
| EvenO : even O
| EvenSS : forall n , even n -> even (S (S n))
.

(*
Natural deduction rules:

------ (EvenO)
even 0

    even n
-------------- (EvenSS)
even (S (S n))

*)

Theorem even_O : even 0.
                   constructor.
Qed.

Theorem even_4 : even 4.
                   constructor.
                   constructor.
                   constructor.
Qed.

Hint Constructors even.

Theorem even_4' : even 4.
                    auto.
Qed.

Theorem even_1_contra : even 1 -> False.
                          inversion 1.
Qed.

Theorem even_3_contra : even 3 -> False.
                          inversion 1.
                          inversion H1.
Qed.

Theorem even_plus : forall n m, even n -> even m -> even (n + m).
                                  induction n; crush.
                                  inversion H.
                                  simpl.
                                  constructor.
                                  Restart.
                                  induction 1.
                                  crush.
                                  intro.
                                  simpl; constructor.
                                  apply IHeven; assumption.
                                  Restart.
                                  induction 1; crush.
Qed.

Theorem even_contra : forall n , even (S (n + n)) -> False.
                                   induction 1.
Abort.

Lemma even_contra' : forall n' , even n' -> forall n, n' = S (n + n) -> False.
                                                        induction 1; crush.
                                                        destruct n; destruct n0; crush.
                                                        SearchRewrite (_ + S _).
                                                        rewrite <- plus_n_Sm in H0.
                                                        apply IHeven with n0; assumption.
                                                        Restart.
                                                        Hint Rewrite <- plus_n_Sm.
                                                        induction 1;crush;
                                                        match goal with
                                                        | [ H : S ?N = ?N0 + ?N0 |- _ ] => destruct N; destruct N0
                                                        end; crush.
Qed.

Theorem even_contra : forall n , even (S (n + n)) -> False.
                                   intros; eapply even_contra'; eauto.
Qed.


(************************************************************************)
(*         *   The Coq Proof Assistant / The Coq Development Team       *)
(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
(* <O___,, *       (see CREDITS file for the list of authors)           *)
(*   \VV/  **************************************************************)
(*    //   *    This file is distributed under the terms of the         *)
(*         *     GNU Lesser General Public License Version 2.1          *)
(*         *     (see LICENSE file for the text of the license)         *)
(************************************************************************)

(** * Zgcd_alt : an alternate version of Z.gcd, based on Euclid's algorithm *)

(**
Author: Pierre Letouzey
*)

(** The alternate [Zgcd_alt] given here used to be the main [Z.gcd]
    function (see file [Znumtheory]), but this main [Z.gcd] is now
    based on a modern binary-efficient algorithm. This earlier
    version, based on Euclid's algorithm of iterated modulo, is kept
    here due to both its intrinsic interest and its use as reference
    point when proving gcd on Int31 numbers *)

Require Import ZArith_base.
Require Import ZArithRing.
Require Import Zdiv.
Require Import Znumtheory.
Require Import Omega.

Open Scope Z_scope.

(** In Coq, we need to control the number of iteration of modulo.
   For that, we use an explicit measure in [nat], and we prove later
   that using [2*d] is enough, where [d] is the number of binary
   digits of the first argument. *)

 Fixpoint Zgcdn (n:nat) : Z -> Z -> Z := fun a b =>
   match n with
     | O => 1 (* arbitrary, since n should be big enough *)
     | S n => match a with
	        | Z0 => Z.abs b
	        | Zpos _ => Zgcdn n (Z.modulo b a) a
	        | Zneg a => Zgcdn n (Z.modulo b (Zpos a)) (Zpos a)
  	      end
   end.

 Definition Zgcd_bound (a:Z) :=
   match a with
     | Z0 => S O
     | Zpos p => let n := Pos.size_nat p in (n+n)%nat
     | Zneg p => let n := Pos.size_nat p in (n+n)%nat
   end.

 Definition Zgcd_alt a b := Zgcdn (Zgcd_bound a) a b.

 (** A first obvious fact : [Z.gcd a b] is positive. *)

 Lemma Zgcdn_pos : forall n a b,
   0 <= Zgcdn n a b.
 Proof.
   induction n.
   simpl; auto with zarith.
   destruct a; simpl; intros; auto with zarith; auto.
 Qed.

 Lemma Zgcd_alt_pos : forall a b, 0 <= Zgcd_alt a b.
 Proof.
   intros; unfold Z.gcd; apply Zgcdn_pos; auto.
 Qed.

 (** We now prove that Z.gcd is indeed a gcd. *)

 (** 1) We prove a weaker & easier bound. *)

 Lemma Zgcdn_linear_bound : forall n a b,
   Z.abs a < Z.of_nat n -> Zis_gcd a b (Zgcdn n a b).
 Proof.
   induction n.
   simpl; intros.
   exfalso; generalize (Z.abs_nonneg a); omega.
   destruct a; intros; simpl;
     [ generalize (Zis_gcd_0_abs b); intuition | | ];
   unfold Z.modulo;
   generalize (Z_div_mod b (Zpos p) (eq_refl Gt));
   destruct (Z.div_eucl b (Zpos p)) as (q,r);
   intros (H0,H1);
   rewrite Nat2Z.inj_succ in H; simpl Z.abs in H;
   (assert (H2: Z.abs r < Z.of_nat n) by
    (rewrite Z.abs_eq; auto with zarith));
    assert (IH:=IHn r (Zpos p) H2); clear IHn;
    simpl in IH |- *;
    rewrite H0.
   apply Zis_gcd_for_euclid2; auto.
   apply Zis_gcd_minus; apply Zis_gcd_sym.
   apply Zis_gcd_for_euclid2; auto.
 Qed.

 (** 2) For Euclid's algorithm, the worst-case situation corresponds
    to Fibonacci numbers. Let's define them: *)

 Fixpoint fibonacci (n:nat) : Z :=
   match n with
     | O => 1
     | S O => 1
     | S (S n as p) => fibonacci p + fibonacci n
   end.

 Lemma fibonacci_pos : forall n, 0 <= fibonacci n.
 Proof.
   enough (forall N n, (n<N)%nat -> 0<=fibonacci n) by eauto.
   induction N.
   inversion 1.
   intros.
   destruct n.
   simpl; auto with zarith.
   destruct n.
   simpl; auto with zarith.
   change (0 <= fibonacci (S n) + fibonacci n).
   generalize (IHN n) (IHN (S n)); omega.
 Qed.

 Lemma fibonacci_incr :
   forall n m, (n<=m)%nat -> fibonacci n <= fibonacci m.
 Proof.
   induction 1.
   auto with zarith.
   apply Z.le_trans with (fibonacci m); auto.
   clear.
   destruct m.
   simpl; auto with zarith.
   change (fibonacci (S m) <= fibonacci (S m)+fibonacci m).
   generalize (fibonacci_pos m); omega.
 Qed.

 (** 3) We prove that fibonacci numbers are indeed worst-case:
    for a given number [n], if we reach a conclusion about [gcd(a,b)] in
    exactly [n+1] loops, then [fibonacci (n+1)<=a /\ fibonacci(n+2)<=b] *)

 Lemma Zgcdn_worst_is_fibonacci : forall n a b,
   0 < a < b ->
   Zis_gcd a b (Zgcdn (S n) a b) ->
   Zgcdn n a b <> Zgcdn (S n) a b ->
   fibonacci (S n) <= a /\
   fibonacci (S (S n)) <= b.
 Proof.
   induction n.
   intros [|a|a]; intros; simpl; omega.
   intros [|a|a] b (Ha,Ha'); [simpl; omega | | easy ].
   remember (S n) as m.
   rewrite Heqm at 2. simpl Zgcdn.
   unfold Z.modulo; generalize (Z_div_mod b (Zpos a) eq_refl).
   destruct (Z.div_eucl b (Zpos a)) as (q,r).
   intros (EQ,(Hr,Hr')).
   Z.le_elim Hr.
   - (* r > 0 *)
     replace (fibonacci (S (S m))) with (fibonacci (S m) + fibonacci m) by auto.
     intros.
     destruct (IHn r (Zpos a) (conj Hr Hr')); auto.
     + assert (EQ' : r = Zpos a * (-q) + b) by (rewrite EQ; ring).
       rewrite EQ' at 1.
       apply Zis_gcd_sym.
       apply Zis_gcd_for_euclid2; auto.
       apply Zis_gcd_sym; auto.
     + split; auto.
       rewrite EQ.
       apply Z.add_le_mono; auto.
       apply Z.le_trans with (Zpos a * 1); auto.
       now rewrite Z.mul_1_r.
       apply Z.mul_le_mono_nonneg_l; auto with zarith.
       change 1 with (Z.succ 0). apply Z.le_succ_l.
       destruct q; auto with zarith.
       assert (Zpos a * Zneg p < 0) by now compute. omega.
   - (* r = 0 *)
     clear IHn EQ Hr'; intros _.
     subst r; simpl; rewrite Heqm.
     destruct n.
     + simpl. omega.
     + now destruct 1.
 Qed.

 (** 3b) We reformulate the previous result in a more positive way. *)

 Lemma Zgcdn_ok_before_fibonacci : forall n a b,
   0 < a < b -> a < fibonacci (S n) ->
   Zis_gcd a b (Zgcdn n a b).
 Proof.
   destruct a; [ destruct 1; exfalso; omega | | destruct 1; discriminate].
   cut (forall k n b,
     k = (S (Pos.to_nat p) - n)%nat ->
     0 < Zpos p < b -> Zpos p < fibonacci (S n) ->
     Zis_gcd (Zpos p) b (Zgcdn n (Zpos p) b)).
   destruct 2; eauto.
   clear n; induction k.
   intros.
   assert (Pos.to_nat p < n)%nat by omega.
   apply Zgcdn_linear_bound.
   simpl.
   generalize (inj_le _ _ H2).
   rewrite Nat2Z.inj_succ.
   rewrite positive_nat_Z; auto.
   omega.
   intros.
   generalize (Zgcdn_worst_is_fibonacci n (Zpos p) b H0); intros.
   assert (Zis_gcd (Zpos p) b (Zgcdn (S n) (Zpos p) b)).
   apply IHk; auto.
   omega.
   replace (fibonacci (S (S n))) with (fibonacci (S n)+fibonacci n) by auto.
   generalize (fibonacci_pos n); omega.
   replace (Zgcdn n (Zpos p) b) with (Zgcdn (S n) (Zpos p) b); auto.
   generalize (H2 H3); clear H2 H3; omega.
 Qed.

 (** 4) The proposed bound leads to a fibonacci number that is big enough. *)

 Lemma Zgcd_bound_fibonacci :
   forall a, 0 < a -> a < fibonacci (Zgcd_bound a).
 Proof.
   destruct a; [omega| | intro H; discriminate].
   intros _.
   induction p; [ | | compute; auto ];
    simpl Zgcd_bound in *;
    rewrite plus_comm; simpl plus;
    set (n:= (Pos.size_nat p+Pos.size_nat p)%nat) in *; simpl;
    assert (n <> O) by (unfold n; destruct p; simpl; auto).

   destruct n as [ |m]; [elim H; auto| ].
   generalize (fibonacci_pos m); rewrite Pos2Z.inj_xI; omega.

   destruct n as [ |m]; [elim H; auto| ].
   generalize (fibonacci_pos m); rewrite Pos2Z.inj_xO; omega.
 Qed.

 (* 5) the end: we glue everything together and take care of
    situations not corresponding to [0<a<b]. *)

 Lemma Zgcd_bound_opp a : Zgcd_bound (-a) = Zgcd_bound a.
 Proof.
  now destruct a.
 Qed.

 Lemma Zgcdn_opp n a b : Zgcdn n (-a) b = Zgcdn n a b.
 Proof.
  induction n; simpl; auto.
  destruct a; simpl; auto.
 Qed.

 Lemma Zgcdn_is_gcd_pos n a b : (Zgcd_bound (Zpos a) <= n)%nat ->
   Zis_gcd (Zpos a) b (Zgcdn n (Zpos a) b).
 Proof.
  intros.
  generalize (Zgcd_bound_fibonacci (Zpos a)).
  simpl Zgcd_bound in *.
  remember (Pos.size_nat a+Pos.size_nat a)%nat as m.
  assert (1 < m)%nat.
  { rewrite Heqm; destruct a; simpl; rewrite 1?plus_comm;
    auto with arith. }
  destruct m as [ |m]; [inversion H0; auto| ].
  destruct n as [ |n]; [inversion H; auto| ].
  simpl Zgcdn.
  unfold Z.modulo.
  generalize (Z_div_mod b (Zpos a) (eq_refl Gt)).
  destruct (Z.div_eucl b (Zpos a)) as (q,r).
  intros (->,(H1,H2)) H3.
  apply Zis_gcd_for_euclid2.
  Z.le_elim H1.
  + apply Zgcdn_ok_before_fibonacci; auto.
    apply Z.lt_le_trans with (fibonacci (S m));
    [ omega | apply fibonacci_incr; auto].
  + subst r; simpl.
    destruct m as [ |m]; [exfalso; omega| ].
    destruct n as [ |n]; [exfalso; omega| ].
    simpl; apply Zis_gcd_sym; apply Zis_gcd_0.
 Qed.

 Lemma Zgcdn_is_gcd n a b :
   (Zgcd_bound a <= n)%nat -> Zis_gcd a b (Zgcdn n a b).
 Proof.
   destruct a.
   - simpl; intros.
     destruct n; [exfalso; omega | ].
     simpl; generalize (Zis_gcd_0_abs b); intuition.
   - apply Zgcdn_is_gcd_pos.
   - rewrite <- Zgcd_bound_opp, <- Zgcdn_opp.
     intros. apply Zis_gcd_minus, Zis_gcd_sym. simpl Z.opp.
     now apply Zgcdn_is_gcd_pos.
 Qed.

 Lemma Zgcd_is_gcd :
   forall a b, Zis_gcd a b (Zgcd_alt a b).
 Proof.
  unfold Zgcd_alt; intros; apply Zgcdn_is_gcd; auto.
 Qed.


(*|
############################
Wellfounded induction in Coq
############################

:Link: https://stackoverflow.com/q/37514716
|*)

(*|
Question
********

Let's say that I know certain natural numbers are *good*. I know ``1``
is good, if ``n`` is good then ``3n`` is, and if ``n`` is good then
``n+5`` is, and those are only ways of constructing good numbers. It
seems to me that the adequate formalization of this in Coq is
|*)

Inductive good : nat -> Prop :=
| g1 : good 1
| g3 : forall n, good n -> good (n * 3)
| g5 : forall n, good n -> good (n + 5).

(*|
However, despite being obvious, the fact that ``0`` is not good seems
not being provable using this definition (because when I invert, in
case of ``g3`` I only get the same thing in the hypothesis).

Now it isn't so obvious what *exactly* are good numbers. And it really
seems that I don't need to characterize them totally in order to know
that ``0`` is not good. For example, I can know that ``2`` is not good
just by doing few inversions.
|*)

(*|
Answer (eponier)
****************

Indeed ``g3`` can be applied an unbounded number of times when trying
to disprove ``good 0``. That is why we can think this proof requires
``induction`` (and we can see that the auxiliary lemma needed in the
solution of @AntonTrunov uses induction). The same idea is used in
theorem ``loop_never_stop`` of
http://www.cis.upenn.edu/~bcpierce/sf/current/Imp.html#lab428.
|*)

Require Import Lia.

Example not_good_0 : ~ good 0.
Proof.
  intros contra. remember 0 as n. induction contra.
  - discriminate.
  - apply IHcontra. lia.
  - lia.
Qed.

(*|
----

**A:** And ``remember 0 as n`` is a crucial component of this
solution. It *sort of* replaces the original statement with ``forall
n, n = 0 -> ~ good n.``. Great answer!
|*)

(*|
Answer (Anton Trunov)
*********************

This problem needs induction. And induction needs some predicate ``P :
nat -> Prop`` to work with. A primitive (constant) predicate like
``(fun n => ~good 0)`` doesn't give you much: you won't be able to
prove the base case for ``1`` (which corresponds to the constructor
``g1``), because the predicate "forgets" its argument.

So you need to prove some logically equivalent (or stronger) statement
which readily will give you the necessary predicate. An example of
such equivalent statement is ``forall n, good n -> n > 0``, which you
can later use to disprove ``good 0``. The corresponding predicate
``P`` is ``(fun n => n > 0)``.
|*)

Reset Initial. (* .none *)
Require Import Coq.Arith.Arith.
Require Import Coq.micromega.Lia.

Inductive good : nat -> Prop :=
| g1 : good 1
| g3 : forall n, good n -> good (n * 3)
| g5 : forall n, good n -> good (n + 5).

Lemma good_gt_O : forall n, good n -> n > 0.
Proof.
  intros n H. induction H; lia.
Qed.

Goal ~ good 0.
  intro H. now apply good_gt_O in H.
Qed.

(*| Here is a proof of the aforementioned equivalence: |*)

Lemma not_good0_gt_zero_equiv_not_good0 :
  (forall n, good n -> n > 0) <-> ~ good 0.
Proof.
  split; intros ? ?.
  - apply H in H0. lia.
  - destruct n; [tauto | lia].
Qed.

(*|
And it's easy to show that ``forall n, n = 0 -> ~ good n`` which
implicitly appears in @eponier's answer is equivalent to ``~ good 0``
too.
|*)

Lemma not_good0_eq_zero_equiv_not_good0 :
  (forall n, n = 0 -> ~ good n) <-> ~ good 0.
Proof.
  split; intros; subst; auto.
Qed.

(*|
Now, the corresponding predicate used to prove ``forall n, n = 0 -> ~
good n`` is ``fun n => n = 0 -> False``. This can be shown by using
manual application of the ``goal_ind`` induction principle,
automatically generated by Coq:
|*)

Example not_good_0_manual : forall n, n = 0 -> ~ good n.
Proof.
  intros n Eq contra.
  generalize Eq.
  refine (good_ind (fun n => n = 0 -> False) _ _ _ _ _);
    try eassumption; intros; lia.
Qed.

(*|
``generalize Eq.`` introduces ``n = 0`` as a premise to the current
goal. Without it the goal to prove would be ``False`` and the
corresponding predicate would be the boring ``fun n => False`` again.
|*)


Require Import Unicode.Utf8.

Section Task_4_8.
  Variables A B C : Prop.
  Variable P : nat → Prop.

  Hypothesis EM: forall p : Prop, p ∨ ¬p.
  Hypothesis DN: forall p : Prop, ¬¬p → p.

  Lemma task1: (A → exists x, P x) → exists x, (A → P x).
  Proof.
    intros exists_P.
    apply DN.
    intro not_exists.

    (* To reach false, let's prove a hypothesis - exists_P - is wrong: *)
    elim exists_P.

    intros x Px.
    (* Again - for false, let's prove a hypothesis is wrong: *)
    elim not_exists.

    (* The 'x' and 'P x' we need are in the hypothesis: *)
    exists x ; intro ; assumption.

    (* Having proved that the consequent of the exists_P implication is wrong,
       we've got to prove its antecedent is true.
       Let's assume the opposite: *)
    apply DN ; intro not_A.

    (* For a contradiction, let's prove the opposite of a hypothesis: *)
    elim not_exists.

    (* Really, now's the hardest part of the proof.
       Took me probably 20 minutes.
       I initially proved the goal with 'forall' instead of 'exists',
       which is a stronger claim, but couldn't integrate it here.

       As the inner term (A → P x) is true for all x given our assumption (¬A),
       we really need to give it just a single x: *)
    exists 42 ; intro ; contradiction.
  Qed.

  Lemma task2: ((A → B) → C) → (A → C) → C.
    intros A_B_impl_C A_impl_C.

    apply DN ; intro not_C.

    (* Now we have (¬C) and (A → C) as hypotheses.
       Obviously, A can't be true.
       Otherwise the implication would be false, because C is false. *)

    (* As I need to reach a contradiction, it would be very useful to
       have another hypothesis.

       As 'A' is false by the above argument, I shall try to add
       (¬A) to my hypotheses. *)

    (* A very easy way to do so is to look at the 2 possibilities for A.
       It might be possible to go without EM, but solving for 'A'
       is straightforward and we can quickly move to ¬A: *)
    elim EM with (p := A).

    intro proof_A.
    (* Having A and ¬C and (A → C), contradiction is easy: *)
    apply not_C in A_impl_C ; assumption.

    (* Now we're just as before the 'EM', but with '¬A' as hypothesis: *)
    intro not_A.

    (* ¬C forces ¬(A → B) because of '(A → B) → C': *)
    apply not_C in A_B_impl_C .

    (* A false goal and a false hypothesis?
       Don't know where it came from, but it's easy: *)
    assumption.

    (* Need A → B while ¬A is available. Trivial: *)
    intro proof_A ; contradiction.
  Qed.

  Lemma task3: (A → B) ∨ (B → A).
  Proof.
    (* Looking at both cases for 'A' makes this extremely easy: *)
    elim EM with (p := A).

    intro proof_A.
    (* First, we have A. But there's a B → A on the right of the disjunction: *)
    right; intro; assumption.

    intro not_A.
    (* Next, we have ¬A. But there's A → B on the left of the disjunction: *)
    left; intro ; contradiction.
  Qed.

  Lemma task4: ((A → B) → A) → A.
  Proof.
    intro.
    (* Obviously, A can't be false in (A → B) → A. *)
    elim EM with (p := A).
    (* The first case - A → A - is trivial *)
    intros ; assumption.

    intro not_A.
    (* In the second case, we have '(A → B) → A' and a goal 'A'.
       Let's prove (A → B) instead: *)
    apply H.

    (* But that's easy, because we assumed ¬A: *)
    intro ; contradiction.
  Qed.

End Task_4_8.


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

Require Import List Arith Nat Lia Relations.

From Undecidability.Shared.Libs.DLW.Utils
  Require Import utils_tac utils_list finite php.

From Undecidability.FOL.TRAKHTENBROT
  Require Import notations.

Set Implicit Arguments.

(* * Kleene's greatest fixpoint of lia-continous operators *)

Section gfp.

  (* We develop the theory of Kleene's greatest fixpoint for binary relations
      and establish the fact that the gfp is an equivalence (under suitable hyps),
      reached after lia many steps (under lia continuity) and
      reached after finitely many steps (under finiteness of the domain and
      preservation of decidability *)

  Variable (M : Type).

  Implicit Type (R T : M -> M -> Prop).

  Notation "R ⊆ T" := (forall x y, R x y -> T x y).

  Notation "R 'o' T" := (fun x z => exists y, R x y /\ T y z) (at level 58).

  Let incl_trans R S T : R ⊆ S -> S ⊆ T -> R ⊆ T.
  Proof. firstorder. Qed.

  Let comp_mono R R' T T' : R ⊆ R' -> T ⊆ T' -> R o T ⊆ R' o T'.
  Proof. firstorder. Qed.

  Variable (F : (M -> M -> Prop) -> M -> M -> Prop).

  Hypothesis (HF0 : forall R T, R ⊆ T -> F R ⊆ F T).  (* Monotonicity *)

  Let sym R := fun x y => R y x.

  Let i := iter F (fun _ _ => True).

  Let iS n : i (S n) = F (i n).
  Proof. apply iter_S. Qed.

  Let i0 : i 0 = fun _ _ => True.
  Proof. auto. Qed.

  Let i_S n : i (S n) ⊆ i n.
  Proof.
    unfold i.
    induction n as [ | n IHn ].
    + simpl; auto.
    + intros ? ?.
      rewrite iter_S with (n := n), iter_S.
      apply HF0, IHn.
  Qed.

  Let i_decr n m : n <= m -> i m ⊆ i n.
  Proof. induction 1; auto. Qed.

  Definition gfp x y := forall n, i n x y.

  Notation I := (@eq M).

  Hypothesis HF1 : I ⊆ F I.    (* Reflexivity *)

  Let i_refl n : I ⊆ i n.
  Proof.
    induction n as [ | n IHn ].
    + rewrite i0; auto.
    + rewrite iS.
      apply incl_trans with (1 := HF1), HF0, IHn.
  Qed.

  Let gfp_refl : I ⊆ gfp.
  Proof. intros ? ? [] ?; apply i_refl; auto. Qed.

  Hypothesis HF2 : forall R, sym (F R) ⊆ F (sym R).   (* Symmetry *)

  Let i_sym n : sym (i n) ⊆ i n.
  Proof.
    induction n as [ | n IHn ].
    + intros ? ?; rewrite i0; simpl; auto.
    + rewrite iS; apply incl_trans with (2 := HF0 _ IHn), HF2.
  Qed.

  Let gfp_sym : sym gfp ⊆ gfp.
  Proof. intros ? ? H ?; apply i_sym, H. Qed.

  Hypothesis HF3 : forall R, F R o F R ⊆ F (R o R).   (* Transitivity *)

  Let i_trans n : i n o i n ⊆ i n.
  Proof.
    induction n as [ | n IHn ].
    + rewrite i0; auto.
    + rewrite iS; apply incl_trans with (1 := @HF3 _), HF0, IHn.
  Qed.

  Let gfp_trans : gfp o gfp ⊆ gfp.
  Proof.
    intros ? ? H ?; apply i_trans.
    revert H; apply comp_mono; auto.
  Qed.

  Fact gfp_equiv : equiv _ gfp.
  Proof using i_trans i_sym i_refl gfp_trans gfp_sym gfp_refl HF3 HF2 HF1.
    msplit 2.
    + intro; apply gfp_refl; auto.
    + intros ? y ? ? ?; apply gfp_trans; exists y; auto.
    + intros ? ?; apply gfp_sym.
  Qed.

  Fact gfp_greatest R : R ⊆ F R -> R ⊆ gfp.
  Proof using HF0.
    intros HR x y H n; revert x y H.
    induction n as [ | n IHn ].
    + now auto.
    + apply incl_trans with (1 := HR).
      rewrite iS; apply HF0; auto.
  Qed.

  Let gfp_fix1 : F gfp ⊆ gfp.
  Proof.
    intros ? ? H ?.
    apply i_S; rewrite iS.
    revert H; apply HF0; auto.
  Qed.

  (* This is ω-continuity *)

  Definition gfp_continuous := forall (s : nat -> M -> M -> Prop),
                        (forall n m, n <= m -> s m ⊆ s n)
                     -> (fun x y => forall n, F (s n) x y) ⊆ F (fun x y => forall n, s n x y).

  Variable HF4 : gfp_continuous.

  Let gfp_fix0 : gfp ⊆ F gfp.
  Proof.
    intros ? ? H.
    apply HF4; auto.
    intro; rewrite <- iS; apply H.
  Qed.

  Fact gfp_fix x y : F gfp x y <-> gfp x y.
  Proof using i_decr i_S gfp_fix1 gfp_fix0 HF4 HF0. split; auto. Qed.

  (* This is for decidability *)

  Let dec R := forall x y, { R x y } + { ~ R x y }.

  Variable HF5 : forall R, dec R -> dec (F R).       (* Preservation of decidability *)

  Let i_dec n : dec (i n).
  Proof.
    induction n as [ | n IHn ].
    + rewrite i0; left; auto.
    + rewrite iS; apply HF5; auto.
  Qed.

  (* For the decidability of gfp, we need the finiteness
      so that gfp = i n for a sufficiently large n *)

  (* A good pair for i (ie n < m and i n ⊆ i m) means gfp is reached  at n *)

  Let i_dup n m : n < m -> i n ⊆ i m -> forall k, n <= k -> forall x y, gfp x y <-> i k x y.
  Proof.
    intros H1 H2.
    generalize (i_decr H1) (i_S n); rewrite iS; intros H3 H4.
    generalize (incl_trans _ _ _ H2 H3); intros H5.
    assert (forall p, i n ⊆ i (p+n)) as H6.
    { induction p as [ | p IHp ]; auto.
      simpl plus; rewrite iS.
      apply incl_trans with (1 := H5), HF0; auto. }
    intros k Hk x y; split; auto.
    intros H a.
    destruct (le_lt_dec a k).
    + revert H; apply i_decr; auto.
    + replace a with (a-n+n) by lia.
      apply H6.
      revert H; apply i_decr; auto.
  Qed.

  (* If there is a good pair below b, then gfp = i b *)

  Let gfp_reached b : (exists n m, n < m <= b /\ i n ⊆ i m) -> (forall x y, gfp x y <-> i b x y).
  Proof.
    intros (n & m & H1 & H2).
    apply i_dup with (2 := H2); auto; try lia.
  Qed.

  Variable HF6 : finite_t M.     (* Finiteness of the domain *)

  (** When M is finite, there is a list [T1;...;Tk] of relations of
      type M -> M -> Prop which contains every weakly decidable relations
      upto equivalence.

      Hence, by the a generalized version of the PHP (proved w/o
      assuming discreteness), for n greater than the length of
      the list for M, one can find a duplicate
      in the list [i 0; ...;i n] ie a < b <= n such
      that i a ~ Tu ~ Tv ~ i b

      Then one can deduce i n ~ gfp *)

  Theorem gfp_finite_t : { n | forall x y, gfp x y <-> i n x y }.
  Proof using i_dup i_decr i_dec i_S gfp_reached HF6 HF5 HF0.
    destruct finite_t_weak_dec_rels with (1 := HF6)
      as (mR & HmR).
    exists (S (length mR)).
    set (l := map i (list_an 0 (S (length mR)))).
    apply (@gfp_reached (S (length mR))).
    destruct php_upto
      with (R := fun R T => forall x y, R x y <-> T x y)
           (l := l) (m := mR)
      as (a & R & b & T & c & H1 & H2).
    + intros R S H ? ?; rewrite H; tauto.
    + intros R S T H1 H2 ? ?; rewrite H1, H2; tauto.
    + intros R HR.
      unfold l in HR; apply in_map_iff in HR.
      destruct HR as (n & <- & _).
      destruct (HmR (i n)) as (T & H1 & H2).
      * intros x y; destruct (i_dec n x y); tauto.
      * exists T; auto.
    + unfold l; rewrite map_length, list_an_length; auto.
    + unfold l in H1; apply map_duplicate_inv in H1.
      destruct H1 as (a' & n & b' & m & c' & H1 & H3 & H4 & H5 & H6 & H7).
      exists n, m; rewrite <- H3, <- H5; split; try (intros ? ?; apply H2).
      apply list_an_duplicate_inv in H7; lia.
  Qed.

  (* As a consequence of been reached after a finite number of steps,
      gfp is one of the i n (for some computable n) and thus decidable *)

  Theorem gfp_decidable : dec gfp.
  Proof using i_dup i_decr i_dec i_S gfp_reached gfp_fix1 HF6 HF5 HF0.
    destruct gfp_finite_t as (n & Hn).
    intros x y; destruct (i_dec n x y); [ left | right ];
      rewrite Hn; tauto.
  Qed.

End gfp.


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

Require Import List.

Require Import base.

Local Notation "R ↓ x" := (fun a b => R a b /\ R b x).

Set Implicit Arguments.

(** The definition of R-homogeneous list for a binary relation R

    homogeneous R (x1::...::xn::nil) <=> ∀ i < j, xi R xj

    see homogeneous_spec below
*)

(** Symbols for copy/paste: ∩ ∪ ⊆ ⊇ ⊔ ⊓ ⊑ ≡  ⋅ ↑ ↓ ⇑ ⇓ ∀ ∃ *)

Section homogeneous.

  Variable (X : Type) (R : X -> X -> Prop).

  Inductive homogeneous : list X -> Prop :=
    | in_homogeneous_0 : homogeneous nil
    | in_homogeneous_1 : ∀ x l, homogeneous l -> Forall (R x) l -> homogeneous (x::l).

  Fact homogeneous_sg x : homogeneous (x::nil).
  Proof. do 2 constructor. Qed.

  Fact homogeneous_inv x l : homogeneous (x::l) <-> Forall (R x) l /\ homogeneous l.
  Proof.
    split.
    * inversion 1; subst; auto.
    * constructor; tauto.
  Qed.

  Fact homogeneous_app_inv l m :
         homogeneous (l++m) <-> homogeneous l
                             /\ homogeneous m
                             /\ ∀ x y, In x l -> In y m -> R x y.
  Proof.
    split.
    + induction l as [ | x l IHl ]; simpl.
      * repeat split; auto; try constructor; intros _ _ [].
      * intros H.
        apply homogeneous_inv in H.
        destruct H as [ H1 H2 ].
        apply IHl in H2.
        destruct H2 as (H2 & H3 & H4).
        apply Forall_app in H1.
        destruct H1 as [ H0 H1 ].
        repeat split; auto.
        constructor; auto.
        intros x' y [ | H' ] Hy; auto.
        subst.
        rewrite Forall_forall in H1; auto.
    + intros (H1 & H2 & H3); revert H3.
      induction H1 as [ | x l H1 IH1 H3 ]; intros H4; simpl; auto.
      constructor.
      * apply IH1; intros; apply H4; auto; right; auto.
      * rewrite Forall_app; split; auto.
        rewrite Forall_forall.
        intros; apply H4; auto; left; auto.
  Qed.

  Fact homogeneous_two_inv x y l : homogeneous (x::y::l) -> R x y.
  Proof.
    inversion 1; subst.
    inversion H3; subst; auto.
  Qed.

  (* This is a non-inductive characterization of homogeneous *)

  Theorem homogeneous_spec ll : homogeneous ll <-> ∀ l x m y r, ll = l++x::m++y::r -> R x y.
  Proof.
    split.
    + intros H l x m y r E; subst.
      rewrite homogeneous_app_inv in H.
      destruct H as (_ & H & _).
      rewrite homogeneous_inv, Forall_app, Forall_cons_inv in H.
      tauto.
    + induction ll as [ | a ll IHll ]; intros Hll; constructor.
      * apply IHll.
        intros l x m y r E.
        apply (Hll (a::l) x m y r); subst; auto.
      * rewrite Forall_forall; intros u Hu.
        apply in_split in Hu; destruct Hu as (l & r & Hu).
        apply (Hll nil a l u r); subst; auto.
  Qed.

  Hypothesis R_dec : forall x y, R x y \/ ~ R x y.

  Theorem homogeneous_dec l : homogeneous l \/ ~ homogeneous l.
  Proof.
    induction l as [ | x l [ H | H ] ].
    + left; constructor.
    + destruct Forall_l_dec with (P := R x) (l := l) as [ H1 | H1 ].
      * intro; apply R_dec.
      * left; constructor; auto.
      * right; contradict H1; rewrite homogeneous_inv in H1; tauto.
    + right; contradict H; rewrite homogeneous_inv in H; tauto.
  Qed.

End homogeneous.

Fact homogeneous_snoc X R ll x : @homogeneous X R (ll ++ x :: nil) -> homogeneous (R↓x) ll.
Proof.
  intros H; apply homogeneous_app_inv in H.
  destruct H as (H1 & _ & H2).
  assert (Forall (fun y => R y x) ll) as H3.
  { rewrite Forall_forall; intros y Hy; apply H2; simpl; auto. }
  clear H2; revert H1 x H3.
  induction 1 as [ | x ll H1 H2 IH2 ]; intros y Hy; simpl.
  + constructor.
  + rewrite Forall_cons_inv in Hy.
    destruct Hy as [ H3 H4 ].
    constructor 2; auto.
    revert IH2 H4; repeat rewrite Forall_forall; firstorder.
Qed.


Require Export P03.

(** **** Problem : 3 stars (mult_comm) *)

Theorem mult_plus_distr_r : forall n m p : nat,
  (n + m) * p = (n * p) + (m * p).
Proof.
  exact FILL_IN_HERE.
Qed.


Require Import Nat Arith.

Inductive Nat : Type := succ : Nat -> Nat |  zero : Nat.

Inductive Lst : Type := cons : Nat -> Lst -> Lst |  nil : Lst.

Inductive Tree : Type := node : Nat -> Tree -> Tree -> Tree |  leaf : Tree.

Inductive Pair : Type := mkpair : Nat -> Nat -> Pair
with ZLst : Type := zcons : Pair -> ZLst -> ZLst |  znil : ZLst.

Fixpoint append (append_arg0 : Lst) (append_arg1 : Lst) : Lst
           := match append_arg0, append_arg1 with
              | nil, x => x
              | cons x y, z => cons x (append y z)
              end.

Fixpoint len (len_arg0 : Lst) : Nat
           := match len_arg0 with
              | nil => zero
              | cons x y => succ (len y)
              end.

Lemma lem : forall l1 l2 n, succ (len (append l1 l2)) = len (append l1 (cons n l2)).
Proof.
   induction l1.
   - intros. simpl. f_equal. apply IHl1.
   - intros. reflexivity.
Qed.

Lemma lem2 : forall l, len l = len (append l nil).
Proof.
   induction l.
   - simpl. f_equal. apply IHl.
   - reflexivity.
Qed.

Theorem theorem0 : forall (x : Lst) (y : Lst), eq (len (append x y)) (len (append y x)).
Proof.
   induction x.
   - intros. simpl. rewrite IHx. apply lem.
   - intros. simpl. apply lem2.
Qed.


Require Import PeanoNat.
Local Open Scope nat_scope.

Inductive btree : Type :=
  | empty : btree
  | node : btree->nat->btree->btree.

Definition tree :=node (node empty 7 (node empty 2 empty)) 1 (node(node empty 10 empty)8 empty).

(*OR(orb) - AND(andb)*)

Fixpoint searchBT(t:btree) (value:nat) : bool :=
  match t with
  |empty =>false
  |node l v r => if v=? value
                  then true
                   else orb (searchBT l value) (searchBT r value)
end.

Compute (searchBT tree 10).
Compute(searchBT tree 24).

(*Oglinditul unui arbore binar de cautare*)
Fixpoint mirroredBT(t:btree):btree:=
  match t with
  | empty =>empty
  | node l v r => node (mirroredBT r) v (mirroredBT l)
end.

(*Verificare arbore binar de cautare*)
Compute (mirroredBT tree).
(*Valoare unui nod*)
Fixpoint returnNodeValue(t :btree):nat :=
  match t with
  |empty=>0
  |node l v r =>v
end.

(*Este arbore binar de cautare?*)
Fixpoint isSearchBT(t:btree):bool :=
  match t with
  | empty => true
  | node empty v empty => true
  | node l v empty =>(returnNodeValue l) <?v
  | node empty v r => v <? (returnNodeValue r)
  | node l v r =>andb ((returnNodeValue l)<?v) (v<?(returnNodeValue r))

end.

Compute (isSearchBT tree).

Compute (isSearchBT (node (node empty 3 empty) 2 (node empty 4 empty ))).

(*Cautare intr-un arbore binar de cautare*)
Fixpoint searchInBST(t:btree) (n:nat):bool :=
  match t with
  |empty => false
  |node l v r => if n=?v
                  then true
                  else if n<?v
                        then searchInBST l n
                        else searchInBST r n
end.

(*Inaltime unui arbore binar*)
Compute searchInBST (tree) (1).
Fixpoint lengthSearchBT(t:btree):nat :=
  match t with
  | empty=>0
  | node l v r => max (lengthSearchBT l) (lengthSearchBT r ) + 1
 end.

Compute(lengthSearchBT tree).


From mathcomp Require Import all_ssreflect all_algebra.

Local Open Scope ring_scope.

Goal 2%:Q + 2%:Q = 4%:Q.
Proof. reflexivity. Qed.

Goal - 2%:Q = -1 * 2%:Q.
Proof. reflexivity. Qed.

Goal 2%:Q ^+ 2 = 4%:Q.
Proof. reflexivity. Qed.

Goal (-1)^-1 = -1 :> rat.
Proof. reflexivity. Qed.

Local Open Scope rat_scope.

Check 12.
Check 3.14.
Check -3.14.
Check 0.5.
Check 0.2.


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

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

Unset Positivity Checking.
Unset Guard Checking.

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

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

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

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

Definition synth (lf3 : natural) (x : natural) : natural :=
  plus (mult x lf3) lf3.


Require Import Arith.

Theorem plus_permute2 : forall n m p:nat, n + m + p = n + p + m.
Proof.
 intros n m p.
 rewrite plus_assoc_reverse.
 pattern (m + p); rewrite plus_comm.
 rewrite plus_assoc_reverse; reflexivity.
Qed.

(** Note : using automatic tactics is better :

*)

Theorem plus_permute2' : forall n m p:nat, n + m + p = n + p + m.
Proof.
 intros n m p; ring.
Qed.


From mathcomp Require Import all_ssreflect.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

(**

----
#
#
** Roadmap for lessons 3 and 4

    - finite types
    - big operators

*)

(**
#
#
----
#
#
** Lesson 3

    - The math-comp library gives some support for finite types.
    - ['I_n] is the the set of natural numbers smaller than n.
    - [a : 'I_n] is composed of a value m and a proof that [m < n].

    - Example : [oid] modifies the proof part with an equivalent one.

#
#
*)

Definition oid n (x : 'I_n) : 'I_n.
Proof.
pose v := nat_of_ord x.
pose H := ltn_ord x.
pose H1 := leq_trans H (leqnn n).
exact: Ordinal H1.
Defined.

(**
#
#
** Note

    - [nat_of_ord] is a coercion (see H)
    - ['I_0] is an empty type
#
#
*)

Lemma empty_i0 (x : 'I_0) : false.
Proof.
case x.
by [].
Qed.

(**
#
#
#
#
----
#
#
  ** Equality

    - Every finite type is also an equality type.
    - For ['I_n], only the value matters

#
#
*)

Definition i3 := Ordinal (isT : 3 < 4).

Lemma ieq : oid i3 == i3.
Proof.
exact: eqxx.
Qed.

Lemma ieq' (h : 3 < 4) : Ordinal h == i3.
Proof.
apply/eqP.
pose H := val_inj.
apply:val_inj.
rewrite /=.
by [].
Qed.

(**
#
#
#
#
----
#
#
   ** An optimic map from [nat] to [ordinal] : [inord]

    - If the expected type has shape 'I_n.+1
    - Takes a natural number as input and return an element of 'I_n.+1
    - The _same number_ if it is small enough, otherwise 0.

#
#
*)

Check inord.

Check inordK.

Check inord_val.

Example inord_val_3_4 : inord 3 = (Ordinal (isT : 3 < 4)) :> 'I_4.
Proof.
apply:val_inj. rewrite /=. rewrite inordK. by []. by [].
Qed.

(**
#
#
#
#
----
#
#
  ** Sequence

    - a finite type can be seen as a sequence
    - [enum T] gives this sequence.
    - it is duplicate free.
    - it relates to the cardinal of a finite type

#
#
*)

Lemma iseq n (x : 'I_n) : x \in 'I_n.
Proof.
set l := enum 'I_n.
move: l; rewrite /= => l.
have ordinal_finType := ordinal_finType.
have mem_enum := mem_enum.
have enum_uniq := enum_uniq.
have cardT := cardT.
have cardE := cardE.
by [].
Qed.

(**
#
#
#
#
----
#
#
  ** Boolean theory of finite types.

    - for finite type, boolean reflection can be extended to quantifiers
    - getting closer to classical logic!

#
#
*)

Lemma iforall (n : nat) : [forall x: 'I_n, x < n].
Proof.
apply/forallP.
rewrite /=.
move=> x.
exact: ltn_ord.
Qed.

Lemma iexists  (n : nat) : (n == 0) || [exists x: 'I_n, x == 0 :> nat].
Proof.
case: n.
by [].
move=> n.
rewrite /=. (* optional, try removing this line. *)
apply/existsP.
pose H : 0 < n.+1 := isT.
pose x := Ordinal H.
exists x.
by [].  (* mention function ord0. *)
Qed.

(**
#
#
#
#
----
#
#
  ** Selecting an element
    - pick selects an element that has a given property
    - pickP triggers the reflection
#
#
*)
Check pick.

Definition izero n (x : 'I_n) := odflt x [pick i : 'I_n | i == 0 :> nat].

Lemma izero_def n (x : 'I_n.+1) : izero x == 0 :> nat.
Proof.
rewrite /izero.
case: pickP.
  rewrite /=.
  by [].
rewrite /=.
move=> H.
have := H (Ordinal (isT : 0 < n.+1)).
rewrite /=.
by [].
Qed.

(**
#
#
#
#
----
#
#
  ** Building finite types
    - SSR automatically discovers the pair of two finite types is finite
    - For functions there is an explicit construction [ffun x => body]
#
#
*)
Check [finType of 'I_3 * 'I_4].
Fail Check [finType of 'I_3 * nat].

Lemma ipair : [forall x : 'I_3 * 'I_4, x.1 * x.2 < 12].
Proof.
apply/forallP.
rewrite /=.
case.
rewrite /=.
move=> a b.
have H := ltn_mul.
rewrite -[12]/(3 * 4).
apply: H.
  by [].
by [].
Qed.

Lemma ifun : [exists f : {ffun 'I_3 -> 'I_4}, forall x, f x == x :> nat].
Proof.
apply/existsP.
rewrite /=.
have H : forall n x, x < n -> x < n.+1.
  move=> n x H.
  rewrite ltnS.
  by rewrite ltnW.
exists [ffun x : 'I_3 => Ordinal (H 3 x (ltn_ord x))].
apply/forallP.
move=> x.
have ffunE' := ffunE.
rewrite ffunE'.
rewrite /=.
by [].
Qed.

(**
#
#
#
#
----
#
#
  ** Installing the finite type structure for an arbitrary type
    - When you have a type that you know is finite, you
      need some work to make it recognized.

#
#
*)Inductive forest_monster :=
  Lion | Tiger | Bear.

Fail Check [finType of forest_monster].

(**
#
#
    - Solution: exhibit an injection into a finite type.
#
#
*)
Definition monster_ord m : 'I_3 :=
  match m with
    Lion => inord 0 | Tiger => inord 1 | _ => inord 2
  end.

Definition ord_monster (n : 'I_3) : option forest_monster :=
  match val n with 0 => Some Lion | 1 => Some Tiger | _ => Some Bear end.

Lemma monster_ord_can : pcancel monster_ord ord_monster.
Proof.
case.
rewrite /=. rewrite /ord_monster. rewrite /= inordK. by []. by [].
by rewrite /ord_monster /= inordK.
by rewrite /ord_monster /= inordK.
Qed.

(**
#
#
    - The lemma monster_ord_can means that there is an injection from
      [forest_monster] into a known finite type. This gives a host of structure
      bridges to [eqType], [choiceType], [countType], [finiteType].
#
#
*)
Canonical fm_eqType := EqType forest_monster (PcanEqMixin monster_ord_can).
Canonical fm_choiceType :=
  ChoiceType forest_monster (PcanChoiceMixin monster_ord_can).
Canonical fm_countType :=
  CountType forest_monster (PcanCountMixin monster_ord_can).
Canonical fm_finType := FinType forest_monster
                                   (PcanFinMixin monster_ord_can).

Check [finType of forest_monster].

(**
#
#
#
#
   ----
   ----
#
#
  ** Big operators
    - Big operators provide a library to manipulate iterations in math-comp
    - this is an encapsulation of the fold function
 #
#
*)
Section F.

Definition f (x : nat) := 2 * x.
Definition g x y := x + y.
Definition r := [::1; 2; 3].

Lemma bfold : foldr (fun val res => g (f val) res) 0 r = 12.
Proof.
rewrite /=.
rewrite /f.
rewrite /g.
by [].
Qed.

End F.

(**
#
#
#
#
----
#
#
   ** Notation

    - iteration is provided by the \big notation
    - the basic operation is on list
    - special notations are introduced for usual case (\sum, \prod, \bigcap ..)
#
#
*)
Lemma bfoldl : \big[addn/0]_(i <- [::1; 2; 3]) i.*2 = 12.
Proof.
rewrite big_cons.
rewrite big_cons.
rewrite big_cons.
rewrite big_nil.
by [].
Qed.

Lemma bfoldlm : \big[muln/1]_(i <- [::1; 2; 3]) i.*2 = 48.
Proof.
rewrite big_cons.
rewrite big_cons.
rewrite big_cons.
rewrite big_nil.
by [].
Qed.

(**
#
#
#
#
----
#
#
   ** Range
    - different ranges are provided
#
#
*)
Lemma bfoldl1 : \sum_(1 <= i < 4) i.*2 = 12.
Proof.
have H := big_ltn.
have H1 := big_geq.
rewrite big_ltn.
  rewrite big_ltn.
    rewrite big_ltn.
      rewrite big_geq.
        by [].
      by [].
    by [].
  by [].
by [].
Qed.

Lemma bfoldl2 : \sum_(i < 4) i.*2 = 12.
Proof.
rewrite big_ord_recl.
rewrite /=.
rewrite big_ord_recl.
rewrite /=.
rewrite big_ord_recl.
rewrite big_ord_recl.
rewrite big_ord0.
by [].
Qed.

Lemma bfoldl3 : \sum_(i : 'I_4) i.*2 = 12.
Proof.
exact: bfoldl2.
Qed.

(**
#
#
#
#
----
#
#
   ** Filtering
    - it is possible to filter elements from the range
#
#
*)
Lemma bfoldl4 : \sum_(i <- [::1; 2; 3; 4; 5; 6] | ~~ odd i) i = 12.
Proof.
have big_pred0 := big_pred0.
have big_hasC := big_hasC.
pose x :=  \sum_(i < 8 | ~~ odd i) i.
pose y :=  \sum_(0 <= i < 8 | ~~ odd i) i.
rewrite big_cons.
rewrite /=.
rewrite big_cons.
rewrite /=.
rewrite big_cons.
rewrite /=.
rewrite big_cons.
rewrite /=.
rewrite big_cons.
rewrite /=.
rewrite big_cons.
rewrite /=.
rewrite big_nil.
by [].
Qed.

(**
#
#
#
#
----
#
#
   ** Switching range
    - it is possible to change representation (big_nth, big_mkord).
#
#
*)
Lemma bswitch :  \sum_(i <- [::1; 2; 3]) i.*2 = \sum_(i < 3) (nth 0 [::1; 2; 3] i).*2.
Proof.
have H := big_nth.
rewrite (big_nth 0).
rewrite /=.
have H1 := big_mkord.
rewrite big_mkord.
by [].
Qed.

(**
#
#
#
#
----
#
#
  ** Big operators and equality
    - one can exchange function and/or predicate
 #
#
*)
Lemma beql :
  \sum_(i < 4 | odd i || ~~ odd i) i.*2 =  \sum_(i < 4) i.*2.
Proof.
have H := eq_bigl.
apply: eq_bigl.
move=> u.
by case: odd.
Qed.

Lemma beqr :
  \sum_(i < 4) i.*2 = \sum_(i < 4) (i + i).
Proof.
have H := eq_bigr.
apply: eq_bigr.
rewrite /=.
move=> u _.
rewrite addnn.
by [].
Qed.

Lemma beq :
  \sum_(i < 4 | odd i || ~~ odd i) i.*2 = \sum_(i < 4) (i + i).
Proof.
have H := eq_big.
apply: eq_big => [u|i Hi]; first by case: odd.
by rewrite addnn.

Qed.

(**
#
#
#
#
----
#
#
  ** Monoid structure
    - one can use associativity to reorganize the bigop
 #
#
*)
Lemma bmon1 : \sum_(i <- [::1; 2; 3]) i.*2 = 12.
Proof.
have H := big_cat.
rewrite -[[::1; 2; 3]]/([::1] ++ [::2; 3]).
rewrite big_cat.
rewrite /=.
rewrite !big_cons !big_nil.
by [].
Qed.

Lemma bmon2 : \sum_(1 <= i < 4) i.*2 = 12.
Proof.
have H := big_cat_nat.
rewrite (big_cat_nat _ _ _ (isT: 1 <= 2)).
  rewrite /=.
  rewrite big_ltn //=.
  rewrite big_geq //.
  by rewrite 2?big_ltn //= big_geq.
by [].
Qed.

Lemma bmon3 : \sum_(i < 4) i.*2 = 12.
Proof.
have H := big_ord_recl.
have H1 := big_ord_recr.
rewrite big_ord_recr.
rewrite /=.
rewrite !big_ord_recr //=.
rewrite big_ord0.
by [].
Qed.

Lemma bmon4 : \sum_(i < 8 | ~~ odd i) i = 12.
Proof.
have H := big_mkcond.
rewrite big_mkcond.
rewrite /=.
rewrite !big_ord_recr /=.
rewrite big_ord0.
by [].
Qed.

(**
#
#
#
#
----
#
#
  ** Abelian Monoid structure
    - one can use communitativity to massage the bigop
 #
#
*)

Lemma bab : \sum_(i < 4) i.*2 = 12.
Proof.
have H := bigD1.
pose x := Ordinal (isT: 2 < 4).
rewrite (bigD1 x).
  rewrite /=.
  rewrite big_mkcond /=.
  rewrite !big_ord_recr /= big_ord0.
  by [].
by [].
Qed.

Lemma bab1 : \sum_(i < 4) (i + i.*2) = 18.
Proof.
have H := big_split.
rewrite big_split /=.
rewrite !big_ord_recr ?big_ord0 /=.
by [].
Qed.

Lemma bab2 : \sum_(i < 3) \sum_(j < 4) (i + j) =
                 \sum_(i < 4) \sum_(j < 3) (i + j).
Proof.
have H := exchange_big.
have H1 := reindex_inj.
rewrite exchange_big.
rewrite /=.
apply: eq_bigr.
move=> i _.
apply: eq_bigr.
move=> j _.
by rewrite addnC.
Qed.

(**
#
#
#
#
----
#
#
  ** Distributivity
    - one can exchange sum and product
 #
#
*)
Lemma bab3 : \sum_(i < 4) (2 * i) = 2 * \sum_(i < 4) i.
Proof.
have H := big_distrr.
by rewrite big_distrr.
Qed.

Lemma bab4 :
  (\prod_(i < 3) \sum_(j < 4) (i ^ j)) =
  \sum_(f : {ffun 'I_3 -> 'I_4}) \prod_(i < 3) (i ^ (f i)).
Proof.
have H := big_distr_big.
have H1 := big_distr_big_dep.
rewrite  (big_distr_big ord0).
rewrite /=.
apply: eq_bigl.
move=> f.
rewrite /=.
apply/forallP.
rewrite /=.
by [].
Qed.

(**
#
#
#
#
----
#
#
  ** Property, Relation and Morphism
 #
#
*)
Lemma bap n : ~~ odd (\sum_(i < n) i.*2).
Proof.
have H := big_ind.
have H1 := big_ind2.
have H2 := big_morph.
elim/big_ind: _.
- by [].
- move=> x y.
  rewrite odd_add.
  case: odd.
     by [].
  by [].
move=> i _.
by rewrite odd_double.
Qed.
(**
#
#
#
#
*)


(* 3 - Case Analysis and Pattern-matching *)

(* 3.1 Non-dependent Case Analysis *)

(* An elimination rule for the type A is some way to use an object a : A in
   order to define an object in some type B. A natural elimination for an
   inductive type is case analysis.

   For instance, any value of type nat is built using either O or S. Thus, a
   systematic way of building a value of type B from any value of type nat is
   to associate to O a constant t0 : B, and to every term of the form 'S p'
   a term ts : B. The following construction has type B:

     match n return B with
     | O => t0
     | S p => ts
     end

    In most of the case, Coq is able to infer the type B of the object
    defined, so the 'return B' part may be omitted. The computing rules
    associated with construct are the expected ones:

      match O return B with O => t0 | S p => ts end ==> to

      match S q return B with O => t0 | S p => ts end ==> ts{q/p} *)

(* 3.2 Dependent Case Analysis *)

(* For a pattern matching construct of the form 'match n with ... end', a
   more general typing rule is obtained considering that the type of the
   whole expression may also depend on n. For instance, consider some
   function Q : nat -> Set, and n : nat. In order to build a term of type Q n,
   we can associate to the constructor O some term tO : Q O and to the pattern
   'S p' some term tS : Q (S p). Note that the terms tO and tS do not have
   the same type. The syntax of the dependent case analysis and its
   associated typing rule are as follows:

     Q : nat -> Set    tO : Q O    p : nat |- tp : Q (S p)    n : nat
    ------------------------------------------------------------------
     match n as nO return Q nO with | O => tO | S p => tS end : Q n

   The former, non-dependent version of case analysis can be obtained from
   this latter rule by taking Q as a constant function on n. *)

(* Strong specification of the predecessor function *)
Definition pred_spec (n : nat) :=
  { m : nat | n = O /\ m = O \/ n = S m }.

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

Print predecessor.
Extraction predecessor.

(* Exercise 3.1 *)
Theorem nat_expand : forall n : nat,
  n = match n with
      | O => O
      | S p => S p
      end.
Proof.
  intro n; induction n; reflexivity.
Qed.

(* The Empty type *)

(* The rule of (non-dependent) case analysis for the type False is (for
   s in Prop, Set or Type):

     Q : s    p : False
    --------------------
     match p return Q with end : Q
*)

Theorem fromFalse : False -> 0 = 1.
Proof. intros; contradiction. Qed.

Print not.

Fact Nosense : O <> O -> 2 = 3.
Proof. intro H; case H; reflexivity. Qed.


(** * Phi : Hofstadter G function and the golden ratio *)

Require Import Arith Fourier R_Ifp R_sqrt Znumtheory Omega.
Require Import Fib FunG.

Open Scope Z.
Open Scope R.

(** We consider again the function [g] defined by
    [g 0 = 0] and [g (S n) = S n - g (g n)],
    and we prove that it can also be directly defined
    via primitives using reals numbers:

    [g(n) = floor((n+1)/phi) = floor(tau*(n+1))]

    where:
     - [phi = (1+sqrt(5))/2]
     - [tau = 1/phi = phi-1 = (sqrt(5)-1)/2]

    In Coq, we'll use here by default operations on reals numbers,
    and also:
     - [INR] : the injection from [nat] to [R]
     - [IZR] : the injection from [Z] to [R]
     - [Int_part] : the integer part of a real, used as a [floor]
       function. It produces a [Z] integer, that we can convert
       to [nat] via [Z.to_nat] when necessary.
     - [frac_part] : the faction part of a real, producing a [R]
*)

(** * Phi and tau *)

Definition phi := (sqrt 5 + 1)/2.
Definition tau := (sqrt 5 - 1)/2.

Lemma tau_1 : tau + 1 = phi.
Proof.
 unfold tau, phi. field.
Qed.

Lemma tau_phi : tau * phi = 1.
Proof.
unfold tau, phi.
replace ((sqrt 5 - 1)/2 * ((sqrt 5 + 1)/2))
with ((sqrt 5 * sqrt 5 - 1)/4) by field.
rewrite sqrt_def. field. fourier.
Qed.

Lemma tau_tau : tau * tau = 1 - tau.
Proof.
 rewrite <- tau_phi, <- tau_1. ring.
Qed.

Lemma tau_nz : tau <> 0.
Proof.
 intro E. generalize tau_phi. rewrite E. intros. fourier.
Qed.

Lemma phi_nz : phi <> 0.
Proof.
 intro E. generalize tau_phi. rewrite E. intros. fourier.
Qed.

Lemma tau_inv : tau = 1/phi.
Proof.
 rewrite <- tau_phi. field. apply phi_nz.
Qed.

Lemma tau_bound : 6/10 < tau < 7/10.
Proof.
 unfold tau.
 assert (11/5 < sqrt 5).
 { replace (11/5) with (sqrt ((11/5)*(11/5))).
   apply sqrt_lt_1; fourier.
   apply sqrt_Rsqr. fourier. }
 assert (sqrt 5 < 12/5).
 { replace (12/5) with (sqrt ((12/5)*(12/5))).
   apply sqrt_lt_1; fourier.
   apply sqrt_Rsqr. fourier. }
 split.
 - apply Rmult_lt_reg_l with 2. fourier.
   apply Rplus_lt_reg_r with 1.
   field_simplify. fourier.
 - apply Rmult_lt_reg_l with 2. fourier.
   apply Rplus_lt_reg_r with 1.
   field_simplify. fourier.
Qed.

(** * A bit of irrationality theory *)

Lemma prime_5 : prime 5.
Proof.
 constructor.
 - omega.
 - intros n Hn. apply Zgcd_1_rel_prime.
   assert (n=1 \/ n=2 \/ n=3 \/ n=4)%Z by omega.
   intuition; now subst.
Qed.

Lemma prime_irr (r:R) :
 (forall (p q:Z), Z.gcd p q = 1%Z -> r * IZR q <> IZR p) ->
 (forall (p q:Z), r * IZR q = IZR p -> q=0%Z).
Proof.
 intros H p q.
 generalize (Z.ggcd_gcd p q) (Z.ggcd_correct_divisors p q)
 (Z.gcd_nonneg p q).
 destruct (Z.ggcd p q) as (g,(p',q')). simpl.
 intros G (Hp,Hq) NN Eq. rewrite <- G in NN.
 subst p; subst q.
 destruct (Z.eq_dec g 0) as [E|N]; [subst; trivial|exfalso].
 apply (H p' q').
 - rewrite Z.gcd_mul_mono_l_nonneg in G by trivial.
   apply Z.mul_reg_l with g; omega.
 - rewrite !mult_IZR in Eq.
   apply Rmult_eq_reg_l with (IZR g). rewrite <- Eq. ring.
   now apply not_0_IZR.
Qed.

Lemma sqrt5_irr (p q:Z) : sqrt 5 * IZR q = IZR p -> q = 0%Z.
Proof.
 apply prime_irr. clear p q. intros p q Hpq Eq.
 assert (Eq' : (p*p = 5 * q*q)%Z).
 { apply eq_IZR; rewrite !mult_IZR, <-!Eq.
   replace (IZR 5) with 5 by (simpl; Rcompute).
   rewrite <- (sqrt_def 5) at 3. ring. fourier. }
 assert (Hpp : (5 | p*p)). { exists (q*q)%Z. rewrite Eq'. ring. }
 assert (Hp : (5 | p)).
 { apply prime_mult in Hpp; intuition. apply prime_5. }
 case Hp. intros p' Hp'.
 assert (Hqq : (5 | q*q)).
 { exists (p'*p')%Z. apply Z.mul_reg_l with 5%Z. omega.
   rewrite Z.mul_assoc, <- Eq', !Hp'. ring. }
 assert (Hq : (5 | q)).
 { apply prime_mult in Hqq; intuition. apply prime_5. }
 assert (H : (5 | 1)).
 { rewrite <- Hpq. apply Z.gcd_greatest; auto. }
 destruct H as (x,Hx). omega.
Qed.

Lemma tau_irr (p q:Z) : tau * IZR q = IZR p -> q = 0%Z.
Proof.
 unfold tau.
 intros Eq.
 apply sqrt5_irr with (2*p+q)%Z.
 rewrite plus_IZR, mult_IZR. simpl (IZR 2).
 rewrite <- Eq. field.
Qed.

(** * Some complements about integer part and fractional part *)

Lemma int_part_iff (r:R)(k:Z) :
 0 <= r-IZR k < 1 <-> Int_part r = k.
Proof.
 split.
 - unfold Int_part.
   intros (H1,H2).
   assert (k+1 = up r)%Z; [|omega].
   apply tech_up; rewrite plus_IZR; simpl; fourier.
 - intros <-. destruct (base_Int_part r). split; fourier.
Qed.

Lemma int_part_carac (r:R)(k:Z) :
 0 <= r-IZR k < 1 -> Int_part r = k.
Proof.
 apply int_part_iff.
Qed.

Lemma int_frac r : r = IZR (Int_part r) + frac_part r.
Proof.
 unfold frac_part. ring.
Qed.

Lemma int_part_le (r:R)(k:Z) : IZR k <= r <-> (k <= Int_part r)%Z.
Proof.
 split.
 - intros.
   destruct (base_Int_part r).
   assert (E : IZR k - 1 < IZR (Int_part r)) by fourier.
   change 1 with (IZR 1) in E.
   rewrite <- minus_IZR in E.
   apply lt_IZR in E. omega.
 - destruct (base_Int_part r).
   intros LE. apply IZR_le in LE. fourier.
Qed.

(** * The main theorem *)

Lemma g_tau (n:nat) : g n = Z.to_nat (Int_part (tau * INR (S n))).
Proof.
induction n as [n IH] using lt_wf_rec.
destruct (eq_nat_dec n 0) as [Hn|Hn].
- subst. change (g 0) with O. simpl.
  replace (tau*1) with tau by ring.
  rewrite (int_part_carac tau 0); simpl; trivial.
  destruct tau_bound; split; fourier.
- assert (0 < INR n). { apply (lt_INR 0). omega. }
  assert (0 <= Int_part (tau * INR n))%Z.
  { apply int_part_le. simpl. destruct tau_bound.
    apply Rmult_le_pos; fourier. }
  set (k:=Z.to_nat (Int_part (tau*INR n))).
  set (d:=frac_part (tau*INR n)).
  replace n with (S (n-1)) at 1 by omega.
  rewrite g_S.
  replace (S (n-1)) with n by omega.
  assert (E : g (n-1) = k).
  { rewrite IH by omega. now replace (S (n-1)) with n by omega. }
  rewrite E.
  assert (k <= n-1)%nat by (rewrite <-E; apply g_le).
  assert (g k < n)%nat by (generalize (g_le k); omega).
  symmetry. apply plus_minus.
  rewrite IH by omega.
  assert (Hd : d <> 0).
  { unfold d. contradict Hn.
    generalize (int_frac (tau*INR n)). rewrite Hn.
    rewrite INR_IZR_INZ at 1. intros Eq.
    apply Nat2Z.inj. simpl.
    apply tau_irr with (Int_part (tau * INR n)).
    rewrite Eq. ring. }
  assert (Hd' : 0 < d < 1).
  { unfold d. destruct (base_fp (tau*INR n)) as (Hd1,Hd2).
    unfold d in *. destruct Hd1; intuition. }
  destruct Hd' as (Hd1,Hd2).
  destruct tau_bound.
  generalize tau_1; intro.
  assert (Eq : INR k = tau*INR n - d).
  { unfold d, k. revert H0. generalize (tau * INR n). clear.
    intros r Hr. rewrite INR_IZR_INZ. rewrite Z2Nat.id; auto.
    rewrite (int_frac r) at 2. ring. }
  destruct (Rle_or_lt d (1-tau)) as [[LT|EQ]|LT].
  + rewrite (int_part_carac (tau*INR(S k)) (Z.of_nat (n-k))).
    rewrite (int_part_carac (tau*INR(S n)) (Z.of_nat k)).
    rewrite !Nat2Z.id. omega.
    * rewrite <- INR_IZR_INZ.
      rewrite S_INR. rewrite Rmult_plus_distr_l.
      rewrite Eq. split; fourier.
    * rewrite <- INR_IZR_INZ, minus_INR, S_INR, Eq by omega.
      replace (_ - _) with (tau-(tau+1)*d) by (ring [tau_tau]).
      rewrite tau_1.
      assert (0 <= phi*d <= tau); [split|intuition fourier].
      { apply Rmult_le_pos; fourier. }
      { replace tau with (phi*(1-tau)).
        apply Rmult_le_compat_l; fourier.
        rewrite <- tau_1. ring [tau_tau]. }
  + rewrite EQ in Eq.
    assert (Z.of_nat n + 1 = 0)%Z.
    apply tau_irr with (Z.of_nat k + 1)%Z.
    rewrite !plus_IZR. simpl.
    rewrite <- !INR_IZR_INZ.
    rewrite Rmult_plus_distr_l. rewrite Eq. ring.
    omega.
  + rewrite (int_part_carac (tau*INR(S k)) (Z.of_nat (n-k-1))).
    rewrite (int_part_carac (tau*INR(S n)) (Z.of_nat (S k))).
    rewrite !Nat2Z.id. omega.
    * rewrite <- INR_IZR_INZ.
      rewrite !S_INR. rewrite Rmult_plus_distr_l.
      rewrite Eq. split; fourier.
    * rewrite <- INR_IZR_INZ, !minus_INR, S_INR, Eq by omega.
      simpl INR.
      replace (_ - _) with ((tau+1)*(1-d)) by (ring [tau_tau]).
      split.
      { apply Rmult_le_pos; fourier. }
      { rewrite <- tau_phi at 3. rewrite Rmult_comm, tau_1.
        apply Rmult_lt_compat_r; fourier. }
Qed.

Lemma g_phi (n:nat) : g n = Z.to_nat (Int_part (INR (S n)/phi)).
Proof.
 rewrite g_tau. do 2 f_equal. rewrite tau_inv. field.
 apply phi_nz.
Qed.


Theorem Ex018 (A B C: Prop): (A \/ B) \/ C <-> A \/ (B \/ C).
Proof.
  split.
  + intro.
    destruct H.
    - destruct H.
      * left. exact H.
      * right. left. exact H.
    - right. right. exact H.
  + intro.
    destruct H.
    - left. left. exact H.
    - destruct H.
      * left. right. exact H.
      * right. exact H.
Qed.


Load LFindLoad.
From lfind Require Import LFind.
Unset Printing Notations.
Set Printing Implicit.

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

Inductive lst : Type := Cons : natural -> lst -> lst |  Nil : lst.

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

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

Fixpoint plus (plus_arg0 : natural) (plus_arg1 : natural) : natural
           := match plus_arg0, plus_arg1 with
              | Zero, n => n
              | Succ n, m => Succ (plus n m)
              end.

Fixpoint mult (mult_arg0 : natural) (mult_arg1 : natural) : natural
           := match mult_arg0, mult_arg1 with
              | Zero, n => Zero
              | Succ n, m => plus (mult n m) m
              end.

Fixpoint exp (exp_arg0 : natural) (exp_arg1 : natural) : natural
           := match exp_arg0, exp_arg1 with
              | n, Zero => Succ Zero
              | n, Succ m => mult (exp n m) n
              end.

Fixpoint qexp (qexp_arg0 : natural) (qexp_arg1 : natural) (qexp_arg2 : natural) : natural
           := match qexp_arg0, qexp_arg1, qexp_arg2 with
              | n, Zero, m => m
              | n, Succ m, p => qexp n m (mult p n)
              end.

Lemma plus_succ : forall (x y : natural), plus x (Succ y) = Succ (plus x y).
Proof.
   intros.
   induction x.
   - reflexivity.
   - simpl. rewrite IHx. reflexivity.
Qed.

Lemma plus_assoc : forall (x y z : natural), plus (plus x y) z = plus x (plus y z).
Proof.
   intros.
   induction x.
   - reflexivity.
   - simpl. rewrite IHx. reflexivity.
Qed.

Lemma plus_zero : forall (x : natural), plus x Zero = x.
Proof.
   intros.
   induction x.
   - reflexivity.
   - simpl. rewrite IHx. reflexivity.
Qed.

Lemma plus_commut : forall (x y : natural), plus x y = plus y x.
Proof.
   intros.
   induction x.
lfind.  reflexivity.
Admitted.

Lemma mult_zero : forall (x : natural), mult x Zero = Zero.
Proof.
   intros.
   induction x.
   - reflexivity.
   - simpl. rewrite IHx. reflexivity.
Qed.

Lemma mult_succ : forall (x y : natural), plus (mult x y) x = mult x (Succ y).
Proof.
   intros.
   induction x.
   - reflexivity.
   - simpl. rewrite plus_succ. rewrite plus_assoc. rewrite (plus_commut y x). rewrite <- plus_assoc. rewrite IHx. rewrite plus_succ. reflexivity.
Qed.

Lemma mult_commut : forall (x y : natural), mult x y = mult y x.
Proof.
   intros.
   induction x.
   - rewrite mult_zero. reflexivity.
   - simpl. rewrite IHx. rewrite mult_succ. reflexivity.
Qed.

Lemma distrib : forall (x y z : natural), mult (plus x y) z = plus (mult x z) (mult y z).
Proof.
   intros.
   induction x.
   - reflexivity.
   - simpl. rewrite IHx. rewrite plus_assoc. rewrite (plus_commut (mult y z) z). rewrite <- plus_assoc. reflexivity.
Qed.

Lemma mult_assoc : forall (x y z : natural), mult (mult x y) z = mult x (mult y z).
Proof.
   intros.
   induction x.
   - reflexivity.
   - simpl. rewrite distrib. rewrite IHx. reflexivity.
Qed.

Theorem theorem0 : forall (x : natural) (y : natural) (z : natural), eq (mult (exp x y) z) (qexp x y z).
Proof.
   intros.
   generalize dependent z.
   induction y.
   - reflexivity.
   - intros. simpl. rewrite <- IHy. rewrite mult_assoc. rewrite (mult_commut x z). reflexivity.
Qed.


(** Cheat sheet available at
      #https://www-sop.inria.fr/teams/marelle/types18/cheatsheet.pdf#
*)

From mathcomp Require Import all_ssreflect.

Implicit Type p q r : bool.
Implicit Type m n a b c : nat.

(**
-----------------------------------------------------------------
#
#
*** Exercise 1:
    - prove this satement by induction
#
#
*)
Lemma iterSr A n (f : A -> A) x : iter n.+1 f x = iter n f (f x).
Admitted.

(**
#
#

#

#
#
#

----------------------------------------------------------
#
#

*** Exercise 2:
    - look up the definition of [iter] (note there is an accumulator varying
      during recursion)
    - prove the following statement by induction

#
#
*)
Lemma iter_predn m n : iter n predn m = m - n.
Proof.
Admitted.
(**
#
#

#

#
#
#

----------------------------------------------------------
#
#

*** Exercise 3:

Prove the sum of the lists [odds n] of exercise 1 is [n ^ 2].

You can prove the following lemmas in any order, some are way easier
than others.

- Recall from exercise 1.
#
#

*)
Definition add2list s := map (fun x => x.+2) s.
Definition odds n := iter n (fun s => 1 :: add2list s) [::].
(**
#
#

- We define a sum operation [suml].

#
#

*)
Definition suml := foldl addn 0.
(**
#
#

- Any [foldl addn] can be rexpressed as a sum.

#
#
*)
Lemma foldl_addE n s : foldl addn n s = n + suml s.
Proof.
Admitted.
(**
#
#

- Not to break abstraction, prove [suml_cons].
#
#
*)
Lemma suml_cons n s : suml (n :: s) = n + suml s.
Admitted.
(**
#
#

- Show how to sum a [add2list].

#
#
*)
Lemma suml_add2list s : suml (add2list s) = suml s + 2 * size s.
Proof.
Admitted.
(**
#
#

- Show the size of a [add2list].

#
#
*)
Lemma size_add2list s : size (add2list s) = size s.
Admitted.
(**
#
#

- Show how many elments [odds] have.

#
#
*)
Lemma size_odds n : size (odds n) = n.
Admitted.
(**
#
#
- Show the final statment.
#
#
*)
Lemma eq_suml_odds n : suml (odds n) = n ^ 2.
Proof.
Admitted.
(**
#
#
#
#
#
(hint)
#
For [eq_suml_odds], use [sqrnD]
#

#
#

#
#
#

----------------------------------------------------------
#
#

*** Exercise 4:

Prove the sum of the lists [odds n] is what you think.

You may want to have at least one itermediate lemma to prove [oddsE]
#
#
*)
Lemma oddsE n : odds n = [seq 2 * i + 1 | i <- iota 0 n].
Proof.
Admitted.
(**
#
#
#
#
#
(hint)
#
this intermediate lemma would be:
#
#
*)
Lemma oddsE_aux n k :
  iter n (fun s : seq nat => 2 * k + 1 :: add2list s) [::] =
  [seq 2 * i + 1 | i <- iota k n].
Admitted.
(**
#
#
#

#
#
#
#
#
*)
Lemma nth_odds n i : i < n -> nth 0 (odds n) i = 2 * i + 1.
Proof.
Admitted.
(**
#
#
#

#
#
#

----------------------------------------------------------
#
#

*** Exercise 5:

Let us prove directly formula
#$$ \sum_{i=0}^{n-1} (2 i + 1) = n ^ 2 $$#
from lesson 1, slightly modified.

Let us first define a custom sum operator:
#
#
*)
Definition mysum m n F := (foldr (fun i a => F i + a) 0 (iota m (n - m))).

Notation "\mysum_ ( m <= i < n ) F" := (mysum m n (fun i => F))
  (at level 41, F at level 41, i, m, n at level 50,
           format "'[' \mysum_ ( m  <=  i  <  n ) '/  '  F ']'").
(**
#
#
- First prove a very useful lemma about summation
#
#
*)
Lemma mysum_recl m n F : m <= n ->
  \mysum_(m <= i < n.+1) F i = \mysum_(m <= i < n) F i + F n.
Proof.
Admitted.
(**
#
#
- Now prove the main result

Do NOT use [eq_suml_odds] above, it would take much more time

#
#
*)
Lemma sum_odds n : \mysum_(0 <= i < n) (2 * i + 1) = n ^ 2.
Proof.
Admitted.
(**
#
#
#

#
#
#
*)


(* This file is generated by Why3's Coq-realize driver *)
(* Beware! Only edit allowed sections below    *)
Require Import BuiltIn.
Require BuiltIn.
Require int.Int.

(* Why3 assumption *)
Definition even (n:Z): Prop := exists k:Z, (n = (2%Z * k)%Z).

(* Why3 assumption *)
Definition odd (n:Z): Prop := exists k:Z, (n = ((2%Z * k)%Z + 1%Z)%Z).

Lemma even_is_Zeven :
  forall n, even n <-> Zeven n.
Proof.
intros n.
refine (conj _ (Zeven_ex n)).
intros (k,H).
rewrite H.
apply Zeven_2p.
Qed.

Lemma odd_is_Zodd :
  forall n, odd n <-> Zodd n.
Proof.
intros n.
refine (conj _ (Zodd_ex n)).
intros (k,H).
rewrite H.
apply Zodd_2p_plus_1.
Qed.

(* Why3 goal *)
Lemma even_or_odd : forall (n:Z), (even n) \/ (odd n).
Proof.
intros n.
destruct (Zeven_odd_dec n).
left.
now apply <- even_is_Zeven.
right.
now apply <- odd_is_Zodd.
Qed.

(* Why3 goal *)
Lemma even_not_odd : forall (n:Z), (even n) -> ~ (odd n).
Proof.
intros n H1 H2.
apply (Zeven_not_Zodd n).
now apply -> even_is_Zeven.
now apply -> odd_is_Zodd.
Qed.

(* Why3 goal *)
Lemma odd_not_even : forall (n:Z), (odd n) -> ~ (even n).
Proof.
intros n H1.
contradict H1.
now apply even_not_odd.
Qed.

(* Why3 goal *)
Lemma even_odd : forall (n:Z), (even n) -> (odd (n + 1%Z)%Z).
Proof.
intros n H.
apply <- odd_is_Zodd.
apply Zeven_plus_Zodd.
now apply -> even_is_Zeven.
easy.
Qed.

(* Why3 goal *)
Lemma odd_even : forall (n:Z), (odd n) -> (even (n + 1%Z)%Z).
Proof.
intros n H.
apply <- even_is_Zeven.
apply Zodd_plus_Zodd.
now apply -> odd_is_Zodd.
easy.
Qed.

(* Why3 goal *)
Lemma even_even : forall (n:Z), (even n) -> (even (n + 2%Z)%Z).
Proof.
intros n H.
apply <- even_is_Zeven.
apply Zeven_plus_Zeven.
now apply -> even_is_Zeven.
easy.
Qed.

(* Why3 goal *)
Lemma odd_odd : forall (n:Z), (odd n) -> (odd (n + 2%Z)%Z).
Proof.
intros n H.
apply <- odd_is_Zodd.
apply Zodd_plus_Zeven.
now apply -> odd_is_Zodd.
easy.
Qed.

(* Why3 goal *)
Lemma even_2k : forall (k:Z), (even (2%Z * k)%Z).
Proof.
intros k.
now exists k.
Qed.

(* Why3 goal *)
Lemma odd_2k1 : forall (k:Z), (odd ((2%Z * k)%Z + 1%Z)%Z).
Proof.
intros k.
now exists k.
Qed.