Set Implicit Arguments.
Require Import Arith.

  (* factorial *)

  Definition state : Set := nat * nat.     (* (n, a) *)

  Inductive init n0 : state -> Prop :=
    start : init n0 (n0, 1).

  Inductive step : state -> state -> Prop :=
    step0 : forall n a, n > 0 -> step (n, a) (n - 1, a * n).

  (*
   * Specification -- program returns `fact n0`
   *  (where n0 is the input, i.e. initial value of n)
   *)
  Definition spec n0 s :=
    match s with
      (0, a) => a = fact n0
    | _ => True
    end.

  Print fact.  (* `fact` is defined in the Arith library *)

  (* General Definition *)
  Section ReflexiveTransitiveClosureDef.

    Variable D : Set.
    Variable R : D -> D -> Prop.

    Inductive tc : D -> D -> Prop :=
      tc_refl : forall s, tc s s
    | tc_step : forall s u t, R s u -> tc u t -> tc s t.

  End ReflexiveTransitiveClosureDef.

  Check tc.
  Print Implicit tc.

  Theorem spec_holds n0 s0 s : init n0 s0 -> tc step s0 s -> spec n0 s.
  Proof.
    intros.
    induction H0.
    - admit.
    - apply IHtc.
Abort.

  Definition inv n0 s :=
    match s with
      (n, a) => a * fact n = fact n0
    end.

  Lemma inv_inv n0 s0 s : init n0 s0 -> tc step s0 s -> inv n0 s.
  Proof.
    intros. induction H0.
    - admit.
    - apply IHtc.
  Abort.

  Lemma inv_inv' n0 s0 s : inv n0 s0 -> tc step s0 s -> inv n0 s.
  Proof.
    intros Inv Reach. induction Reach.
    - assumption.
    - apply IHReach.
      destruct H.
      destruct n.
      + inversion H.
      + simpl. unfold inv in Inv.
        rewrite Nat.sub_0_r.
        rewrite <- Nat.mul_assoc.
        assumption.
  Qed.

  Lemma inv_inv n0 s0 s : init n0 s0 -> tc step s0 s -> inv n0 s.
  Proof.
    intro Init.
    apply inv_inv'.
    unfold inv. destruct Init.
    firstorder.
  Qed.

  Theorem spec_holds n0 s0 s : init n0 s0 -> tc step s0 s -> spec n0 s.
  Proof.
    intros.
    enough (inv n0 s).
    - destruct s.
      unfold spec.
      destruct n.
      destruct H1.
      + firstorder.
      + constructor.
    - eapply inv_inv.
      eassumption.
      assumption.
  Qed.


(** * Tutoriel 1 - Prouver avec Coq : Logique du premier ordre *)

(** Dans cette feuille, nous simulons la logique du premier ordre
    dans le cadre plus riche de la logique de Coq.
    À cet effet, nous déclarons un type [T] pour les termes, un prédicat
    unaire [P], une proposition [Q], et une relation [R]. *)

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

(** ** I. Quantifications universelle et existentielle *)

(** Les tactiques [intro] et [apply] sont utilisées également pour raisonner
    sur les quantifications universelles, tandis que les tactiques [exists]
    et [destruct] sont utilisées pour les quantifications existentielles. *)

Goal (exists x:T, forall y:T, R x y)
  -> (forall y:T, exists x:T, R x y).
Proof.
  intros H y.
  destruct H.
  exists x.
  apply H.
Qed.

Goal (exists x:T, P x \/ Q) -> ((exists x:T, P x) \/ Q).
Proof.
  intro H. destruct H. destruct H.
   + left.  exists x. exact H.
   + right. exact H.
Qed.

(** *** Exercice 1 - A vous de jouer ! *)

Lemma exists_not_forall : forall P : nat -> Prop,
(exists n, P n) ->  ~(forall n,~ (P n)).
Proof.
intros P H. unfold not. intro Hn. destruct H. apply Hn with (n:=x). exact H.
Qed.

(** Note : Ici aussi, l'ordre supérieur a été utilisé. *)

(** *** Exercice 2 - A vous de jouer ! *)

(** Pour le résultat suivant, nous devons être capable d'introduire une
    existentielle avec un terme arbitraire. Ceci n'est pas autorisé dans Coq,
    où les types peuvent être vides. Nous postulons donc l'existence de
    au moins un élément dans [T]. *)

Variable a : T.

Goal ((exists x:T, P x) \/ Q) -> (exists x:T, P x \/ Q).
Proof.
intros H. destruct H. destruct H. exists x. left. exact H. exists a. right. exact H.
Qed.

(** ** II. Egalité *)

(** L'égalité étant réflexive, la tactique [reflexivity] permet de clore
    un but lorsque les 2 éléments à gauche et à droite d'une égalité sont
    égaux syntaxiquement.

    De plus, la tactique [rewrite] permet d'utiliser une égalité,
    c'est-à-dire de réécrire x en y grâce à x = y.
    Pour réécrire y en x grâce à x = y, il faut utiliser la tactique
    [rewrite <-]. *)

Variable f : T -> T.

Lemma eq_arg : forall x y : T, x = y -> f x = f y.
Proof.
  intros x y Heq.
  rewrite Heq.
  reflexivity.
Qed.

Goal forall x y : T, x = y -> P y -> P x.
Proof.
  intros x y Heq H.
  rewrite Heq.
  exact H.
Qed.

Goal forall x y : T, forall z:T,
  x = y -> f y = z -> P (f x) -> P z.
Proof.
  intros x y z Hxy Hfyz H.
  rewrite <- Hxy in Hfyz.
  rewrite Hfyz in H.
  exact H.
Qed.

(** *** Exercice 3 - Symétrie et transitivité de l'égalité *)

(** La symétrie et la transitivité sont des conséquences du principe
    de substitution incarné par la tactique de [rewrite] : prouvez-le ! *)

Lemma symmetry : forall x y : T, x = y -> y = x.
Proof.
intros x y Eq. rewrite <- Eq. reflexivity.
Qed.

Lemma transitivity : forall x y z : T, x = y -> y = z -> x = z.
Proof.
intros x y z Eq1 Eq2. rewrite <- Eq1 in Eq2. exact Eq2.
Qed.

(** A présent, vous avez le droit d'utiliser la tactique [symmetry]
    pour échanger les 2 membres d'une égalité. *)

(** *** Exercice 4 - Fonctions *)

(** Ici, nous définissons une nouvelle sorte de termes, et diverses
    propriétés de fonctions sur ces termes.
    Démontrez le théorème en guise d'exercice. *)

Module Functions.

  Variable A : Type.

  Definition injective (f:A->A) :=
    forall x:A, forall y:A, f x = f y -> x = y.

  Definition surjective (f:A->A) :=
    forall x:A, exists y:A, x = f y.

  Definition bijective (f:A->A) := injective f /\ surjective f.

  Definition involutive (f:A->A) := forall x:A, f (f x) = x.

  Theorem inv_bij : forall (f:A->A), involutive f -> bijective f.
  Proof.
  intros f HypInv. split.
  + intros x y HypEq. destruct (HypInv x). destruct (HypInv y). rewrite HypEq. reflexivity.
  + intro x. exists (f x). rewrite HypInv. reflexivity.
Qed.

End Functions.

(** ** III. Exercice avancé *)

(** *** Exercice 5 - Le paradoxe du buveur (Drinker's paradox) *)

(** Comme exercice avancé (probablement pour la prochaine fois), prouvez que
    la formule du buveur tient, en utilisant un raisonnement classique et en
    en supposant que l'univers des termes n'est pas vide. *)

Module Drinker.

  (** Supposons un bar non vide, et un prédicat indiquant
      quelles personnes dans le bar boivent. *)

  Variable Person : Type.
  Variable p : Person.
  Variable Drinks : Person -> Prop.

  (** Vous pouvez utiliser n'importe lequel des deux axiomes équivalents. *)

  Axiom RAA : forall P:Prop, ~~P -> P.
  Axiom LEM : forall P:Prop, P \/ ~P.

  (** Vous allez probablement vouloir utiliser [LEM] en premier,
      mais sachez que l'utilisation de seulement [RAA] amène à plus
      de difficulté. *)

  Goal exists x:Person, Drinks x -> forall y:Person, Drinks y.
  Proof.
    apply RAA. unfold not. intro H.

End Drinker.

(** Merci à David Baelde et Catherine Dubois. *)


(** * 6.512 Formal Reasoning About Programs, Spring 2023 - Pset 4 *)

Require Coq816.
Require Import Frap.

Notation t := nat.

Inductive tree :=
| Leaf (* an empty tree *)
| Node (d : t) (l r : tree).

Notation compare := Compare_dec.lt_eq_lt_dec.
Notation Lt := (inleft (left _)) (only parsing).
Notation Eq := (inleft (right _)) (only parsing).
Notation Gt := (inright _) (only parsing).

Module Type S.
  Definition Singleton (v: t) := Node v Leaf Leaf.
  Fixpoint bst (tr : tree) (s : t -> Prop) : Prop :=
    match tr with
    | Leaf => forall x, not (s x)
    | Node d l r =>
        s d /\
        bst l (fun x => s x /\ x < d) /\
        bst r (fun x => s x /\ d < x)
    end.

  Parameter rotate : tree -> tree.

  (*[10%]*) Axiom bst_rotate : forall T s (H : bst T s), bst (rotate T) s.

  Fixpoint insert (a: t) (tr: tree) : tree :=
    match tr with
    | Leaf => Singleton a
    | Node v lt rt =>
      match compare a v with
      | Lt => Node v (insert a lt) rt
      | Eq => tr
      | Gt => Node v lt (insert a rt)
      end
    end.

  Fixpoint rightmost (tr: tree) : option t :=
    match tr with
    | Leaf => None
    | Node v _ rt =>
      match rightmost rt with
      | None => Some v
      | r => r
      end
    end.

  Definition is_leaf (tr : tree) : bool :=
    match tr with Leaf => true | _ => false end.

  Fixpoint delete_rightmost (tr: tree) : tree :=
    match tr with
    | Leaf => Leaf
    | Node v lt rt =>
      if is_leaf rt
      then lt
      else Node v lt (delete_rightmost rt)
    end.

  Definition merge_ordered lt rt :=
    match rightmost lt with
    | Some rv => Node rv (delete_rightmost lt) rt
    | None => rt
    end.

  Fixpoint delete (a: t) (tr: tree) : tree :=
    match tr with
    | Leaf => Leaf
    | Node v lt rt =>
      match compare a v with
      | Lt => Node v (delete a lt) rt
      | Eq => merge_ordered lt rt
      | Gt => Node v lt (delete a rt)
      end
    end.

  (*[40%]*) Axiom bst_insert :
    forall tr s a,
      bst tr s ->
      bst (insert a tr) (fun x => s x \/ x = a).

  (*[50%]*) Axiom bst_delete :
    forall tr s a, bst tr s ->
              bst (delete a tr) (fun x => s x /\ x <> a).
End S.

(* three-way comparisions and [cases] support for them *)
Ltac cases E :=
  (is_var E; destruct E) ||
    match type of E with
    | sumor (sumbool _ _) _ => destruct E as [[]|]
    | {_} + {_} => destruct E
    | _ => let Heq := fresh "Heq" in
           destruct E eqn:Heq
    end;
   repeat
    match goal with
    | H:_ = left _ |- _ => clear H
    | H:_ = right _ |- _ => clear H
    | H:_ = inleft _ |- _ => clear H
    | H:_ = inright _ |- _ => clear H
    end.

(*|
TIPS: A few things that might be helpful keep in mind as you work on pset 4
===========================================================================
 *)

(*|
Paper proof and reasoning will help
===================================
Problem set 4 is a lot less guided than previous assignments: you will need to prove multiple lemmas for each of the BST theorems, and we did not give the exact statement of each lemma.  Think about the proofs on paper, take each proof slowly, and do not hesitate to prove useful intermediate results as separate lemmas.

And if you get stuck, come to office hours!
 *)

(*|
Take advantage of propositional
===============================
When writing specifications, you can enable [propositional] to prove more stuff
by sticking to a minimal convention about which comparison operators you use.
We chose to pick [x<y] over [y>x] and [not (y<x)] over [x<=y]. This helps just
a little.
*)

(*|
HINTS: A few hints to help you if you get stuck on certain
       problems in Pset 4.
       Beware! Don't read further if you don't want spoilers!
=============================================================
|*)

(*|
HINT 1:
=======
Definition rotR (T : tree) :=
  match T with
  | Node t L R =>
      match L with
       | Node l A B => Node l A (Node t B R)
       | _ => T
      end
  | _ => T
  end.

Lemma bst_rotR T S (H : bst T S) : bst (rotR T) S.
Proof.
  cases T; propositional.
  cases T1; propositional.
  simplify; propositional;
    use_bst_iff_assumption; propositional; linear_arithmetic.
Qed.

Definition rotL (T : tree) :=
  match T with
  | Node t A R =>
      match R with
       | Node r B X => Node r (Node t A B) X
       | _ => T
      end
  | _ => T
  end.

Lemma bst_rotL T S (H : bst T S) : bst (rotL T) S.
Proof.
  cases T; propositional.
  cases T2; propositional.
  simplify; propositional.
  { eapply bst_iff.
    { eassumption. }
    { propositional.
      linear_arithmetic. } }
  { eapply bst_iff; try eassumption. propositional; linear_arithmetic. }
  { eapply bst_iff; try eassumption. propositional; linear_arithmetic. }
Qed.
*)

(*|
HINT 2:
=======
Consider [cases (rightmost tr2)] or [cases (is_leaf tr2)] instead of [cases
tr2]. Not breaking apart the tree itself can avoid a mess.
*)

(*|
HINT 3:
=======
A convenient way to specify "the largest element in this set" is to say that
all elements in this set are no larger than the given element.
*)

(*|
HINT 4:
=======
merge_ordered needs a rather strong precondition. It does not work correctly
for merging just any two trees. However, it is called in a rather specific
scenario. (And it is feasible to prove its use by inlining it, but we found a
separate specification helpful.) Why is it bad to call merge_ordered [3,4] [1,2]?
*)

(*|
HINT 5:
=======
Our proof, if avoiding eapply, contains a couple of long apply-with invocations, for example:
apply bst_iff with (P:=let S := (fun x : t => S x /\ d < x) in (fun x : t => S x /\ x < rm)).
*)


Require Import Graph.
Require Import Helper.
Require Import Wellfounded.
Require Import Coq.Lists.ListDec.
Require Import Omega.

Module PathTheories  (O: UsualOrderedType)(S: FSetInterface.Sfun O)(G: Graph O S).

  Import G.

(*There are a lot of essentially equivalent definitions of being a path in here. The only ones I use
  are [path_list_ind] and [path_list_rev], which are also the most general, so we can get rid of the others*)

  Inductive path : graph -> vertex -> vertex -> Prop :=
  | p_start : forall g u v,
    contains_edge g u v = true -> path g u v
  | p_continue: forall g u v w,
    path g u w ->
    contains_edge g w v = true ->
    path g u v.

  Inductive path' : graph -> vertex -> vertex -> Prop :=
  | p_start' : forall g u v,
    contains_edge g u v = true -> path' g u v
  | p_continue': forall g u v w,
    contains_edge g u w = true ->
    path' g w v ->
    path' g u v.

  Lemma path_trans: forall g u v w,
    path g u v ->
    path g v w ->
    path g u w.
  Proof.
    intros. induction H0.
    - eapply p_continue. apply H. apply H0.
    - eapply p_continue. apply IHpath. apply H. apply H1.
  Qed.

  Lemma path'_trans: forall g u v w,
    path' g u v ->
    path' g v w ->
    path' g u w.
  Proof.
    intros. induction H.
    - eapply p_continue'. apply H. apply H0.
    - eapply p_continue'. apply H. apply IHpath'. apply H0.
  Qed.

  Lemma path_path': forall g v u,
    path g u v <-> path' g u v.
  Proof.
    intros. split; intros H; induction H.
    - apply p_start'. apply H.
    - eapply path'_trans. apply IHpath. apply p_start'. apply H0.
    - apply p_start. apply H.
    - eapply path_trans. apply p_start. apply H. apply IHpath'.
Qed.

  Inductive path_with: graph -> vertex -> vertex -> (vertex -> bool) -> Prop :=
    |  pw_start : forall g u v f,
      contains_edge g u v = true ->
      f v = true ->
      path_with g u v f
    | pw_continue: forall g u v w f,
      path_with g u w f ->
      f v = true ->
      contains_edge g w v = true ->
      path_with g u v f.

  Inductive path_list_ind: graph -> vertex -> vertex -> (vertex -> bool) -> list vertex -> Prop :=
    | pl_start : forall g u v f,
      contains_edge g u v = true ->
      f v = true ->
      path_list_ind g u v f nil
    | pl_continue: forall g u v w f l,
      path_list_ind g u w f l ->
      f v = true ->
      contains_edge g w v = true ->
      path_list_ind g u v f (w :: l).

Fixpoint path_list_rev (g: graph) (u v: vertex) (l: list vertex) : bool :=
  match l with
  | nil => G.contains_edge g u v
  | x :: tl => G.contains_edge g x v && path_list_rev g u x tl
  end.

Lemma path_list_ind_rev: forall g u v l f,
  path_list_ind g u v f l <-> (path_list_rev g u v l = true /\ (forall y, In y l -> f y = true) /\ f v = true).
Proof.
  intros. split; intros. induction H.
  - simpl in *. split. apply H. split. intros. destruct H1. apply H0.
  - simpl. destruct IHpath_list_ind. destruct H3. split. rewrite H1. rewrite H2. reflexivity.
    split. intros. destruct H5. subst. apply H4. apply H3. apply H5. apply H0.
  - generalize dependent v. induction l; intros.
    + destruct H. destruct H0. simpl in *. apply pl_start. apply H. apply H1.
    + simpl in *. apply pl_continue. apply IHl. destruct H. destruct H0. split. rewrite andb_true_iff in H.
      apply H. split. intros. apply H0. right. apply H2. apply H0. left. reflexivity. destruct H.
      destruct H0. apply H1. destruct H. rewrite andb_true_iff in H. destruct H. apply H.
Qed.

  Lemma path_with_implies_path: forall g u v f,
    path_with g u v f ->
    path g u v.
  Proof.
    intros. induction H.
    - apply p_start. apply H.
    - eapply p_continue. apply IHpath_with. apply H1.
  Qed.

  Lemma path_path_list_rev: forall g u v,
    path g u v <-> (exists l, path_list_rev g u v l = true).
  Proof.
    intros. split; intros. induction H.
    - exists nil. simpl. apply H.
    - destruct_all. exists (w :: x). simpl. simplify.
    - destruct H. generalize dependent v. induction x; intros.
      + simpl in H. constructor. apply H.
      + simpl in H. simplify. eapply p_continue. apply IHx. apply H1. apply H0.
  Qed.

  Definition cyclic (g: graph) := exists v, path g v v.

  (*There is a cycle that does not consist only of a single vertex*)
  Definition nontrivial_cyclic (g: graph) := exists v l, (exists x, x <> v /\ In x l)
   /\ path_list_rev g v v l = true.

  Definition acyclic (g: graph):= ~ exists v, path g v v.

  Definition acyclic' (g: graph) := forall v, ~path g v v.

  Lemma acylic_no_nontrivial: forall g,
    acyclic g ->
    ~nontrivial_cyclic g.
  Proof.
   intros. intro.  unfold acyclic in H. unfold nontrivial_cyclic in H0. destruct_all.
    apply H. exists x. rewrite path_path_list_rev. exists x0. apply H1.
  Qed.

  Lemma acyclic_equiv: forall g,
    acyclic' g <-> acyclic g.
  Proof.
    intros. split; intros; unfold acyclic in *; unfold acyclic' in *. intro. destruct H0. apply (H x). apply H0.
    intros. intro. apply H. exists v. apply H0.
  Qed.

  Lemma alt_acyclic: forall g,
    acyclic g <-> (forall u v, path g u v -> u <> v).
  Proof.
    intros. split; intros.
    - intro. subst. unfold acyclic in H. apply H. exists v. apply H0.
    - unfold acyclic. intro. destruct H0. apply H in H0. contradiction.
  Qed.

(** ** Some results about paths **)
  Lemma path_app: forall g u v a l1 l2,
    path_list_rev g u v (l1 ++ a :: l2) = true <->
    path_list_rev g a v l1 = true /\ path_list_rev g u a l2 = true.
  Proof.
    intros. split; intros. generalize dependent v. generalize dependent l2. induction l1; intros.
    - simpl in H. simpl. rewrite andb_true_iff in H. apply H.
    - simpl in *. simplify; apply IHl1 in H1; destruct H1; assumption.
    - destruct_all. generalize dependent v. generalize dependent a. revert l2. induction l1; intros.
      + simpl in *. simplify.
      + simpl in *. simplify.
  Qed.

  Lemma path_end: forall u v l x g l1,
    l = l1 ++ x :: nil ->
    path_list_rev g u v l = true <-> path_list_rev g x v l1 = true /\ G.contains_edge g u x = true.
  Proof.
    intros. subst. split; intros.
    - apply path_app in H. simpl in H. apply H.
    - apply path_app. simpl. apply H.
Qed.

  (*If there is a path from u to v, then there is a path from u to v that does not contain u as an intermediate
    vertex*)
  Lemma path_start_unique: forall g u v l,
    path_list_rev g u v l = true ->
    exists l1, path_list_rev g u v l1 = true /\ ~In u l1.
  Proof.
    intros. destruct (in_dec O.eq_dec u l).
    - apply in_split_app_fst in i. destruct_all. rewrite H0 in H.
      apply path_app in H. destruct H. exists x. split. apply H.
      intro. apply H1 in H3. contradiction. apply O.eq_dec.
    - exists l. split; assumption.
  Qed.

  Lemma path_implies_in_graph: forall g u v l,
    path_list_rev g u v l = true ->
    G.contains_vertex g u = true /\ G.contains_vertex g v = true /\ (forall x, In x l -> G.contains_vertex g x = true).
  Proof.
    intros. generalize dependent v. induction l; intros.
    - simpl in H. split. eapply G.contains_edge_1. apply H. split. eapply G.contains_edge_2. apply H.
      intros. inversion H0.
    - simpl in H. simplify. apply IHl in H1. simplify. eapply G.contains_edge_2. apply H0.
      simpl in H. destruct H. subst. eapply G.contains_edge_1. apply H0. apply IHl in H1.
      destruct_all. apply H3. apply H.
  Qed.

(* Results about cycle *)
Lemma any_cycle: forall g u v l,
  path_list_rev g u u l = true ->
  In v l ->
  exists l1, path_list_rev g v v l1 = true /\ In u l1 /\ (forall x, x <> u -> x <> v -> In x l <-> In x l1).
Proof.
  intros. apply in_split_app_fst in H0. destruct_all.
  rewrite H0 in H. apply path_app in H. destruct_all.
  exists (x0 ++ u :: x). split. eapply path_app; simplify.
  intros. split. solve_in. split; intros.  subst. apply in_app_or in H5. destruct H5. solve_in.
  simpl in H0. destruct H0. subst. contradiction. solve_in.
  subst. apply in_app_or in H5. destruct H5. solve_in. simpl in H0. destruct H0.
  subst. contradiction. solve_in.
  apply O.eq_dec.
Qed.

Lemma path_remove_cycle: forall g u v w l1 l2 l3,
  path_list_rev g u v (l1 ++ w :: l2 ++ w :: l3) = true ->
  path_list_rev g u v (l1 ++ w :: l3) = true.
Proof.
  intros. apply path_app in H. destruct_all. apply path_app in H0. destruct_all.
  apply path_app. simplify.
Qed.

Lemma path_no_end: forall g u v l,
  path_list_rev g u v l = true ->
  exists l, path_list_rev g u v l = true /\ ~In v l.
Proof.
  intros. destruct (in_dec O.eq_dec v l).
    - apply in_split_app_snd in i. destruct_all. rewrite H0 in H.
      apply path_app in H. destruct H. exists x0. split. apply H2.
      intro. apply H1 in H3. contradiction. apply O.eq_dec.
    - exists l. split; assumption.
Qed.

(*If there is a path, then there is a path with no duplicates*)
Lemma path_no_dups: forall g u v l,
  path_list_rev g u v l = true ->
  exists l1, path_list_rev g u v l1 = true /\ NoDup l1 /\ ~In u l1 /\  ~In v l1 /\
  (forall x, In x l1 -> In x l).
  Proof.
    intros. induction l using (well_founded_induction
                       (wf_inverse_image _ nat _ (@length _)
                          PeanoNat.Nat.lt_wf_0)).
    destruct (NoDup_dec (O.eq_dec) l).
    - destruct (In_dec O.eq_dec u l).
      + eapply in_split_app_fst in i. destruct_all. clear H2. subst.
        apply path_app in H. destruct H. specialize (H0 x). destruct H0 as [l].
        rewrite app_length. simpl. assert (forall n m, n < n + S(m)) by (intros; omega). apply H0.
        apply H. exists l. simplify. apply O.eq_dec.
      + destruct (In_dec O.eq_dec v l).
        * eapply in_split_app_fst in i. destruct_all; subst. clear H2. apply path_app in H.
          destruct H. specialize (H0 x0). destruct H0 as [l]. rewrite app_length. simpl.
          assert (forall n m, n < m + S(n)) by (intros; omega). apply H0. apply H1. exists l.
          simplify. apply O.eq_dec.
        * exists l. simplify.
    - rewrite no_no_dup in n. destruct_all. subst.
      apply path_remove_cycle in H. specialize (H0 (x0 ++ x :: x2)). destruct H0 as [l].
      repeat(rewrite app_length; simpl). omega. apply H. exists l. simplify. apply H5 in H4.
      apply in_app_or in H4. destruct H4. apply in_or_app. left. apply H4. simpl in H4.
      destruct H4. subst. solve_in. solve_in. apply O.eq_dec.
Qed.

(*A crucial lemma for proving the correctness of cycle detection: If there is a cycle that does not
  consist solely of the same vertex, then there is a cycle with no duplicates
TODO: see if I can prove this from path_no_dups*)
Lemma cycle_no_dups_strong: forall g u l,
  path_list_rev g u u l = true ->
  (exists w, In w l /\ w <> u) ->
  exists l1, path_list_rev g u u l1 = true /\ NoDup l1 /\ ~In u l1 /\ l1 <> nil /\ (forall x, In x l1 -> In x l).
Proof.
  intros. induction l using (well_founded_induction
                     (wf_inverse_image _ nat _ (@length _)
                        PeanoNat.Nat.lt_wf_0)). destruct_all. destruct l.
  inversion H0. destruct (In_dec O.eq_dec u (v ::l)).
  apply in_split_app_fst in i. destruct_all.
  rewrite H3 in H. apply path_app in H. destruct_all. rewrite H3 in H0.
  apply in_app_or in H0. destruct H0.
  assert (exists l1 : list vertex,
       path_list_rev g u u l1 = true /\
       NoDup l1 /\ ~ In u l1 /\ l1 <> nil /\ (forall x : vertex, In x l1 -> In x x0)).
  apply H1. rewrite H3. rewrite app_length. simpl.
  assert (forall n m, n < n + S(m)). intros. omega. apply H6.
  apply H. exists x. split; assumption.
  destruct_all. exists x2. repeat(split; try(assumption)). intros. rewrite H3.
  apply H10 in H11. solve_in.
  simpl in H0. destruct H0. subst. contradiction.
  assert ( exists l1 : list vertex,
       path_list_rev g u u l1 = true /\
       NoDup l1 /\ ~ In u l1 /\ l1 <> nil /\ (forall x : vertex, In x l1 -> In x x1)).
  apply (H1 x1). rewrite H3. rewrite app_length. simpl.
  assert (forall n m, n < m + S(n)). intros. omega. apply H6.
  apply H5. exists x. split; assumption. destruct_all.
  exists x2. repeat(split; try(assumption)). intros.
  apply H10 in H11. rewrite H3. solve_in. apply O.eq_dec.
  destruct (NoDup_dec (O.eq_dec) (v :: l)).
  exists (v :: l). split; try(split); try(assumption). split. apply n. split.
  intro. inversion H3. intros. apply H3.
  rewrite no_no_dup in n0. destruct_all. rewrite H3 in H.
  apply path_remove_cycle in H. rewrite H3 in H0.
  rewrite H3 in n. assert (exists l1 : list vertex,
       path_list_rev g u u l1 = true /\
       NoDup l1 /\ ~ In u l1 /\ l1 <> nil /\ (forall x : vertex, In x l1 -> In x (x1 ++ x0 :: x3))).
  apply H1.  rewrite H3.
  repeat(rewrite app_length; simpl). omega. apply H. exists x0.
  split. solve_in. intro. subst. apply n. solve_in. destruct_all. exists x4.
  repeat(split; try(assumption)). intros. rewrite H3. apply H8 in H9.
  apply in_app_or in H9. simpl in H9. destruct H9. apply in_or_app. left. apply H9.
  destruct H9. subst. solve_in. solve_in.  apply O.eq_dec.
Qed.

(** Decidability of [path] **)

(*We want to be able to use the existence of a path as a boolean in other functions, so we need to show that
  it is decidable. To do this, we give a (very inefficient) algorithm to find a path and prove it correct.
  But we are only concerned with existence so its efficiency is not important*)

(*A terrible function to find if a path of length <= n between two vertices exists*)
Fixpoint path_of_length g (u v : G.vertex) (n: nat) {struct n} : bool :=
  match n with
  | 0 => G.contains_edge g u v
  | S(m) => if G.contains_edge g u v then true else
  fold_right (fun x t => if path_of_length g u x m && G.contains_edge g x v then true else t) false
  (G.list_of_graph g)
  end.

(*If this function returns true, there is a path between two vertices *)
Lemma path_of_length_implies_path: forall g u v n,
  path_of_length g u v n = true -> path g u v.
Proof.
  intros. generalize dependent v. induction n; intros.
  - simpl in H. constructor. apply H.
  - simpl in *. destruct (G.contains_edge g u v) eqn : ?.
    + apply p_start. apply Heqb.
    + assert (forall l, fold_right
      (fun (x : G.vertex) (t : bool) => if path_of_length g u x n && G.contains_edge g x v then true else t) false
      l = true-> exists x, In x l /\ path_of_length g u x n = true /\ G.contains_edge g x v = true). {
      intros. induction l; simpl in *.
      * inversion H0.
      * destruct (path_of_length g u a n && G.contains_edge g a v) eqn : ?.
        -- simplify. exists a. simplify.
        -- apply IHl in H0. destruct_all. exists x. simplify. }
      apply H0 in H. destruct_all. eapply p_continue. apply IHn. apply H1. apply H2.
Qed.

Lemma path_of_size_implies_function: forall g u v l n,
  length l <= n ->
  path_list_rev g u v l = true -> path_of_length g u v n = true.
Proof.
  intros. generalize dependent v. revert u. generalize dependent n. induction l; simpl in *; intros.
  - destruct n. simpl. apply H0. simpl. rewrite H0. reflexivity.
  - simplify. destruct n. omega. assert (length l <= n) by omega. clear H.
    simpl. destruct (G.contains_edge g u v) eqn : ?. reflexivity.
      assert (forall a l', In a l' ->
      path_of_length g u a n = true ->
      G.contains_edge g a v = true ->
      fold_right
  (fun (x : G.vertex) (t : bool) => if path_of_length g u x n && G.contains_edge g x v then true else t)
  false l' = true). { intros. induction l'; simpl in *.
  - destruct H.
  - destruct H. subst. rewrite H3. rewrite H4. simpl. reflexivity. apply IHl' in H.
    destruct (path_of_length g u a1 n && G.contains_edge g a1 v). reflexivity. apply H. }
    apply (H a). apply G.list_of_graph_1. eapply G.contains_edge_1. apply H1. apply IHl. apply H0. apply H2.
    apply H1.
Qed.

(*If there is a path, then there is a path at most as large as the number of vertices in the graph (because
  there is a path with no duplicates and every vertex is in the graph*)
Lemma path_shorter_than_graph_size: forall g u v l,
  path_list_rev g u v l = true ->
  exists l', path_list_rev g u v l' = true /\ length l' <= length(G.list_of_graph g).
Proof.
  intros. apply path_no_dups in H. destruct_all.
  assert (forall a, In a x -> In a (G.list_of_graph g)). intros.
  apply path_implies_in_graph in H. destruct_all. apply H6 in H4. apply G.list_of_graph_1. apply H4.
  exists x. split. apply H. eapply NoDup_incl_length. apply H0. unfold incl. apply H4.
Qed.

Lemma path_equiv: forall g u v,
  path g u v <-> path_of_length g u v (length(G.list_of_graph g)) = true.
Proof.
  intros. split; intros.
  - rewrite path_path_list_rev in H. destruct H. apply path_shorter_than_graph_size in H.
    destruct_all. eapply path_of_size_implies_function. apply H0. apply H.
  - eapply path_of_length_implies_path. apply H.
Qed.

Lemma path_dec: forall g u v,
  {path g u v} + {~path g u v}.
Proof.
  intros. destruct (path_of_length g u v (length(G.list_of_graph g))) eqn : ?.
  left. apply path_equiv; assumption.
  right. intro. apply path_equiv in H. rewrite H in Heqb. inversion Heqb.
Qed.

Lemma path_transpose: forall g u v,
  path g u v <-> path (G.get_transpose g) v u.
Proof.
  intros. split; intros.
  - induction H.
    + constructor. rewrite <- G.transpose_edges. apply H.
    + eapply path_trans. apply p_start. rewrite <- G.transpose_edges. apply H0. apply IHpath.
  - remember (get_transpose g) as gt. induction H; subst.
    + apply G.transpose_edges in H. constructor. apply H.
    + eapply path_trans. apply p_start. apply G.transpose_edges. apply H0. apply IHpath. reflexivity.
Qed.

End PathTheories.


Theorem identity_fn_applied_twice :
  forall (f : bool -> bool),
  (forall (x : bool), f x = x) ->
  forall (b : bool), f (f b) = b.
Proof.
  intros f.
  intros f_id.
  intros b.
  rewrite f_id.
  rewrite f_id.
  reflexivity.
Qed.

Theorem andb_eq_orb :
  forall (b c : bool),
  (andb b c = orb b c) ->
  b = c.
Proof.
  intros b c. induction b.
    - induction c.
      + simpl. intro t_t. exact t_t.
      + simpl. intro f_t. rewrite f_t. reflexivity.
    - simpl. intro f_c. exact f_c.
Admitted.

Module NatPlayground.
Inductive binary_nat : Type :=
| O : binary_nat
| E : binary_nat -> binary_nat
| D : binary_nat -> binary_nat.

Definition incr (n : binary_nat) : binary_nat :=
  match n with
  | O => E O
  | E n => D n
  | D (E n) => D (D n)
  | D n => D (E n)
  end.

Fixpoint bin_to_nat (n : binary_nat) : nat :=
  match n with
  | O => 0
  | E n => 1 + (bin_to_nat n)
  | D n => 2 + (bin_to_nat n)
  end.

Example test_bin_incr1 : bin_to_nat O = 0.
Proof.
simpl. reflexivity.
Qed.

Example test_bin_incr2 : bin_to_nat (incr O) = 1.
Proof.
simpl. reflexivity.
Qed.

Example test_bin_incr3 : bin_to_nat (incr (incr O)) = 2.
Proof.
simpl. reflexivity.
Qed.

Example test_bin_incr4 : bin_to_nat (incr (incr (incr O))) = 3.
Proof.
simpl. reflexivity.
Qed.

Example test_bin_incr5 : bin_to_nat (incr (incr (incr (incr O)))) = 4.
Proof.
simpl. reflexivity.
Qed.

End NatPlayground.


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

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

Notation "x <? y" := (ltb x y) (at level 70) : nat_scope.
Example test_ltb1: (ltb 2 2) = false.
Proof. simpl. reflexivity. Qed.
Example test_ltb2: (ltb 2 4) = true.
Proof. simpl. reflexivity. Qed.
Example test_ltb3: (ltb 4 2) = false.
Proof. simpl. reflexivity. Qed.
Example test_ltb4: (ltb 0 2) = true.
Proof. simpl. reflexivity. Qed.


Require Import ProofCheckingEuclid.euclidean_axioms.
Require Import ProofCheckingEuclid.lemma_equalitysymmetric.

Section Euclid.

Context `{Ax:euclidean_neutral}.

Lemma lemma_inequalitysymmetric :
	forall A B,
	neq A B ->
	neq B A.
Proof.
	intros A B.
	intros neq_A_B.
	intros eq_B_A.

	pose proof (lemma_equalitysymmetric _ _ eq_B_A) as eq_A_B.
	contradict eq_A_B.
	exact neq_A_B.
Qed.

End Euclid.