Require Export prop_j.

Definition funny_prop1 := forall n, forall (E : ev n), ev (n+4).

Definition funny_prop1' := forall n, forall (_ : ev n), ev (n+4).

Definition funny_prop1'' := forall n, ev n -> ev(n+4).

Inductive and (P Q : Prop) : Prop :=
  conj : P -> Q -> (and P Q).

Notation "P /\ Q" := (and P Q) : type_scope.

Check conj.

Theorem and_example :
  (ev 0) /\ (ev 4).
Proof.
  apply conj.
  apply ev_0.
  apply ev_SS. apply ev_SS. apply ev_0. Qed.

Print and_example.

Theorem proj1 : forall P Q : Prop,
  P /\ Q -> P.
Proof.
  intros P Q H.
  inversion H as [HP HQ].
  apply HP. Qed.

Theorem proj2 : forall P Q : Prop,
  P /\ Q -> Q.
Proof.
  intros.
  inversion H as [HP HQ].
  apply HQ. Qed.

Theorem and_commut : forall P Q : Prop,
  P /\ Q -> Q /\ P.
Proof.
  intros P Q H.
  inversion H as [HP HQ].
  split.
    apply HQ.
    apply HP.
Qed.

Print and_commut.

Theorem and_assoc : forall P Q R : Prop,
  P /\ (Q /\ R) -> (P /\ Q) /\ R.
Proof.
  intros P Q R H.
  inversion H as [HP [HQ HR]].
  apply conj.
  apply conj.
  apply HP.
  apply HQ.
  apply HR.
Qed.

Theorem even_ev : forall n : nat,
  (even n -> ev n) /\ (even (S n) -> ev (S n)).
Proof.
  intros.
  induction n as [| n'].
  Case "n = 0".
    apply conj.
    SCase "left".
      intros. apply ev_0.
    SCase "right".
      intros. inversion H.
  Case "n = S n'".
    inversion IHn'.
    apply conj.
    SCase "left".
      intros. apply H0. apply H1.
    SCase "right".
      unfold even. simpl. intros. apply ev_SS.
      apply H. unfold even. apply H1.
Qed.

Definition conj_fact : forall P Q R,
  P /\ Q -> Q /\ R -> P /\ R :=
  fun (P Q R : Prop) (H : P /\ Q) (H0 : Q /\ R) =>
    match H with
    | conj _ _ HP HQ =>
      match H0 with
      | conj _ _ HQ HR => conj P R HP HR
      end
    end.

Definition iff(P Q : Prop) := (P -> Q) /\ (Q -> P).

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

Theorem iff_implies : forall P Q : Prop,
  (P <-> Q) -> P -> Q.
Proof.
  intros P Q H.
  inversion H as [HAB HBA]. apply HAB.  Qed.

Theorem iff_sym : forall P Q : Prop,
  (P <-> Q) -> (Q <-> P).
Proof.
  intros P Q H.
  inversion H as [HAB HBA].
  split.
    Case "->". apply HBA.
    Case "<-". apply HAB.  Qed.

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

Theorem iff_trans : forall P Q R : Prop,
  (P <-> Q) -> (Q <-> R) -> (P <-> R).
Proof.
  intros. inversion H. inversion H0.
  split.
    Case "->". intros. apply H3. apply H1. apply H5.
    Case "<-". intros. apply H2. apply H4. apply H5.
Qed.

SearchAbout MyProp.
Print iff.

Definition MyProp_iff_ev : forall n, MyProp n <-> ev n :=
  fun (n:nat) => conj (MyProp n -> ev n) (ev n -> MyProp n) (ev_MyProp n) (MyProp_ev n).

Inductive or (P Q : Prop) : Prop :=
  | or_introl : P -> or P Q
  | or_intror : Q -> or P Q.

Notation "P \/ Q" := (or P Q) : type_scope.

Check or_introl.
Check or_intror.

Theorem or_commut : forall P Q : Prop,
  P \/ Q  -> Q \/ P.
Proof.
  intros P Q H.
  inversion H as [HP | HQ].
    Case "right". apply or_intror. apply HP.
    Case "left". apply or_introl. apply HQ.  Qed.

Theorem or_commut' : forall P Q : Prop,
  P \/ Q  -> Q \/ P.
Proof.
  intros P Q H.
  inversion H as [HP | HQ].
    Case "right". right. apply HP.
    Case "left". left. apply HQ.  Qed.

Definition or_commut_object : forall P Q : Prop, P \/ Q -> Q \/ P :=
  fun (P Q : Prop) (H : P \/ Q) =>
    match H with
    | or_introl _ _ HP => or_intror _ _ HP
    | or_intror _ _ HQ => or_introl _ _ HQ
    end.

Theorem or_distributes_over_and_1 : forall P Q R : Prop,
  P \/ (Q /\ R) -> (P \/ Q) /\ (P \/ R).
Proof.
  intros P Q R. intros H. inversion H as [HP | [HQ HR]].
    Case "left". split.
      SCase "left". left. apply HP.
      SCase "right". left. apply HP.
    Case "right". split.
      SCase "left". right. apply HQ.
      SCase "right". right. apply HR.  Qed.

Theorem or_distributes_over_and_2 : forall P Q R : Prop,
  (P \/ Q) /\ (P \/ R) -> P \/ (Q /\ R).
Proof.
  intros.
  inversion H.
  inversion H0 as [HP | HQ].
    SCase "left". left. apply HP.
    SCase "right".
      inversion H1 as [HP | HR].
        Case "left". left. apply HP.
        Case "right".
          right. apply conj. apply HQ. apply HR.
Qed.

Theorem or_distrubutes_over_and : forall P Q R : Prop,
  P \/ (Q /\ R) <-> (P \/ Q) /\ (P \/ R).
Proof.
  intros. unfold iff. apply conj.
    Case "->".
    intros. inversion H.
      SCase "left".
      apply conj. left. apply H0. left. apply H0.
      SCase "right".
      inversion H0.
      apply conj. right. apply H1. right. apply H2.
    Case "<-".
      apply or_distributes_over_and_2.
Qed.

Theorem andb_true__and : forall b c,
  andb b c = true -> b = true /\ c = true.
Proof.
  (* WORKED IN CLASS *)
  intros b c H.
  destruct b.
    Case "b = true". destruct c.
      SCase "c = true". apply conj. reflexivity. reflexivity.
      SCase "c = false". inversion H.
    Case "b = false". inversion H.  Qed.

Theorem and__andb_true : forall b c,
  b = true /\ c = true -> andb b c = true.
Proof.
  (* WORKED IN CLASS *)
  intros b c H.
  inversion H.
  rewrite H0. rewrite H1. reflexivity. Qed.

Theorem andb_false : forall b c,
  andb b c = false -> b = false \/ c = false.
Proof.
  intros. unfold andb in H. destruct b.
    Case "b = true". right. apply H.
    Case "b = false". left. apply H.
Qed.

Theorem orb_true : forall b c,
  orb b c = true -> b = true \/ c = true.
Proof.
  intros. unfold orb in H. destruct b.
    Case "b = true". left. reflexivity.
    Case "b = false". right. apply H.
Qed.

Theorem orb_false : forall b c,
  orb b c = false -> b = false /\ c = false.
Proof.
  intros. unfold orb in H. destruct b.
    Case "b = true". inversion H.
    Case "b = false". apply conj. reflexivity. apply H.
Qed.

Inductive False : Prop := .

Theorem False_implies_nonsense :
  False -> 2 + 2 = 5.
Proof.
  intros contra.
  inversion contra.  Qed.

Theorem nonsense_implies_False :
  2 + 2 = 5 -> False.
Proof.
  intros contra.
  inversion contra.  Qed.

Theorem ex_falso_quodlibet : forall (P:Prop),
  False -> P.
Proof.
  intros P contra.
  inversion contra.  Qed.

Inductive True : Prop :=
  | true_constructer : True.

Print True_ind.

Definition not (P:Prop) := P -> False.
Notation "~ x" := (not x) : type_scope.

Check not.

Theorem not_False :
  ~ False.
Proof.
  unfold not. intros H. inversion H.  Qed.

Theorem contradiction_implies_anything : forall P Q : Prop,
  (P /\ ~P) -> Q.
Proof.
  (* WORKED IN CLASS *)
  intros P Q H. inversion H as [HP HNA]. unfold not in HNA.
  apply HNA in HP. inversion HP.  Qed.

Theorem double_neg : forall P : Prop,
  P -> ~~P.
Proof.
  (* WORKED IN CLASS *)
  intros P H. unfold not. intros G. apply G. apply H.  Qed.

Theorem contrapositive : forall P Q : Prop,
  (P -> Q) -> (~Q -> ~P).
Proof.
  unfold not. intros. apply H0. apply H. apply H1.
Qed.

Theorem not_both_true_and_false : forall P : Prop,
  ~ (P /\ ~P).
Proof.
  unfold not. intros. inversion H. apply H1. apply H0.
Qed.

Theorem five_not_even :
  ~ ev 5.
Proof.
  unfold not. intros.
  inversion H. inversion H1. inversion H3.
Qed.

Theorem ev_not_ev_S : forall n,
  ev n -> ~ ev (S n).
Proof.
  intros. unfold not. induction H.
    Case "ev_0". intros. inversion H.
    Case "ev_SS".
      intros.
      apply IHev.
      apply ev_minus2 in H0.
      simpl in H0.
      apply H0.
Qed.

Definition peirce := forall P Q: Prop,
  ((P->Q)->P)->P.
Definition classic := forall P:Prop,
  ~~P -> P.
Definition excluded_middle := forall P:Prop,
  P \/ ~P.
Definition de_morgan_not_and_not := forall P Q:Prop,
  ~(~P/\~Q) -> P\/Q.
Definition implies_to_or := forall P Q:Prop,
  (P->Q) -> (~P\/Q).

Theorem peirce__classic :
  peirce -> classic.
Proof.
  unfold peirce. unfold classic. unfold not.
  intros. apply H with (Q:=False). intros.
  apply H0 in H1. inversion H1.
Qed.

Theorem classic__excluded_middle :
  classic -> excluded_middle.
Proof.
  unfold classic. unfold excluded_middle. unfold not.
  intros H Q.  apply H. intros.
  apply H0. right. intros. apply H0. left. apply H1.
Qed.

Theorem excluded_middle__de_morgan_not_and_not :
  excluded_middle -> de_morgan_not_and_not.
Proof.
  unfold excluded_middle.
  unfold de_morgan_not_and_not.
  unfold not.
  intros. assert (P \/ ~P).
    Case "Proof of Assertion". apply H.
  unfold not in H1. inversion H1.
    Case "left". left. apply H2.
    Case "right".
      assert (Q \/ ~Q).
        SCase "Proof of Assertion". apply H.
      unfold not in H3.
      inversion H3.
        SCase "left". right. apply H4.
        SCase "right".
          assert (False).
            SSCase "Proof of assertion".
              apply H0.
              apply conj. apply H2. apply H4.
          inversion H5.
Qed.

Theorem de_morgan_not_and_not__implies_to_or :
  de_morgan_not_and_not -> implies_to_or.
Proof.
  unfold de_morgan_not_and_not.
  unfold implies_to_or.
  unfold not.
  intros. apply H. intros. inversion H1.
  apply H2. intros. apply H3.
  apply H0. apply H4.
Qed.

Theorem implies_to_or__excluded_middle :
  implies_to_or -> excluded_middle.
Proof.
  unfold implies_to_or.
  unfold excluded_middle.
  intros.
  apply or_commut.
  apply H.
  intros. apply H0.
Qed.

Theorem implies_to_or__peirce :
  implies_to_or -> peirce.
Proof.
  unfold peirce.
  unfold not.
  intros H.
  intros P Q.
  assert excluded_middle.
    apply implies_to_or__excluded_middle.
    apply H.
  unfold excluded_middle in H0.
  intros.
  assert (Q \/ ~Q).
    apply H0.
  inversion H2.
  apply H1.
  intros.
  apply H3.
  assert (P \/ ~P).
    apply H0.
  inversion H4.
  apply H5.
  apply H1.
  intros.
  unfold not in H5.
  apply H5 in H6.
  inversion H6.
Qed.

Notation "x <> y" := (~ (x = y)) : type_scope.

Theorem not_false_then_true : forall b : bool,
  b <> false -> b = true.
Proof.
  intros b H. destruct b.
  Case "b = true". reflexivity.
  Case "b = false".
    unfold not in H.
    apply ex_falso_quodlibet.
    apply H. reflexivity.   Qed.

Theorem not_eq_beq_false : forall n n' : nat,
  n <> n' ->
  beq_nat n n' = false.
Proof.
  intros n.
  unfold not.
  induction n.
    Case "n = 0".
    intros.
    destruct n'.
      assert (0 = 0). reflexivity.
      apply H in H0. inversion H0.
      simpl. reflexivity.
    intros.
    Case "n = S n".
    destruct n'.
      simpl. reflexivity.
      simpl. apply IHn. intros.
      apply H. rewrite H0. reflexivity.
Qed.

Theorem beq_false_not_eq : forall n m,
  false = beq_nat n m -> n <> m.
Proof.
  unfold not.
  intros n.
  induction n as [| n'].
  Case "n = 0".
    intros.
    destruct m.
      inversion H.
      intros. inversion H0.
  Case "n = S n'".
    intros.
    destruct m.
      inversion H0.
      inversion H0. generalize H2.
      apply IHn'. simpl in H. apply H.
Qed.

Inductive ex (X:Type) (P : X -> Prop) : Prop :=
  ex_intro : forall (witness:X), P witness -> ex X P.

Definition some_nat_is_even : Prop :=
  ex nat ev.

Definition snie : some_nat_is_even :=
  ex_intro _ ev 4 (ev_SS 2 (ev_SS 0 ev_0)).

Notation "'exists' x , p" := (ex _ (fun x => p))
  (at level 200, x ident, right associativity) : type_scope.
Notation "'exists' x : X , p" := (ex _ (fun x:X => p))
  (at level 200, x ident, right associativity) : type_scope.

Example exists_example_1 : exists n, n + (n * n) = 6.
Proof.
  apply ex_intro with (witness:=2).
  reflexivity.  Qed.

Example exists_example_1' : exists n,
     n + (n * n) = 6.
Proof.
  exists 2.
  reflexivity.  Qed.

Theorem exists_example_2 : forall n,
     (exists m, n = 4 + m) ->
     (exists o, n = 2 + o).
Proof.
  intros n H.
  inversion H as [m Hm].
  exists (2 + m).
  apply Hm.  Qed.

Definition p : ex nat (fun n => ev (S n)) :=
  ex_intro nat (fun n => ev (S n)) 1 (ev_SS 0 ev_0).

Theorem dist_not_exists : forall (X:Type) (P : X -> Prop),
  (forall x, P x) -> ~ (exists x, ~ P x).
Proof.
  intros.
  unfold not.
  intros.
  inversion H0 as [x IHE].
  apply IHE. apply H.
Qed.

Theorem not_exists_dist :
  excluded_middle ->
  forall (X:Type) (P : X -> Prop),
    ~ (exists x, ~ P x) -> (forall x, P x).
Proof.
  unfold excluded_middle.
  intros excluded_middle.
  unfold not.
  intros X P Hnen x.
  assert (P x \/ ~(P x)).
    Case "Proof of Assertion". apply excluded_middle.
  inversion H.
  apply H0.
  assert (exists x : X , ~(P x)).
    Case "Proof of Assertion". exists x. apply H0.
  apply Hnen in H1. inversion H1.
Qed.

Theorem dist_exists_or : forall (X:Type) (P Q : X -> Prop),
  (exists x, P x \/ Q x) <-> (exists x, P x) \/ (exists x, Q x).
Proof.
  intros.
  unfold iff.
  apply conj.
  Case " -> ".
    intros.
    inversion H.
    inversion H0.
      SCase "left".
        left. exists witness. apply H1.
      SCase "right".
        right. exists witness. apply H1.
  Case "<-".
    intros.
    inversion H.
      SCase "left". inversion H0.
        exists witness. left. apply H1.
      SCase "right". inversion H0.
        exists witness. right. apply H1.
Qed.

Module MyEquality.

Inductive eq (X:Type) : X -> X -> Prop :=
  refl_equal : forall x, eq X x x.

Notation "x = y" := (eq _ x y)
                    (at level 70, no associativity) : type_scope.

Inductive eq' (X:Type) (x:X) : X -> Prop :=
    refl_equal' : eq' X x x.

Notation "x =' y" := (eq' _ x y)
                     (at level 70, no associativity) : type_scope.

Theorem two_defs_of_eq_coincide : forall (X:Type) (x y : X),
  x = y <-> x =' y.
Proof.
  unfold iff.
  intros. apply conj.
      Case "->". intros. inversion H. apply refl_equal'.
      Case "<-". intros. inversion H. apply refl_equal.
Qed.

Check eq'_ind.

Definition four : 2 + 2 = 1 + 3 :=
  refl_equal nat 4.
Definition singleton : forall (X:Set) (x:X), []++[x] = x::[]  :=
  fun (X:Set) (x:X) => refl_equal (list X) [x].

End MyEquality.

Module LeFirstTry.

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

End LeFirstTry.

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

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

Check le_ind.

Theorem test_le1 :
  3 <= 3.
Proof.
  (* WORKED IN CLASS *)
  apply le_n.  Qed.

Theorem test_le2 :
  3 <= 6.
Proof.
  (* WORKED IN CLASS *)
  apply le_S. apply le_S. apply le_S. apply le_n.  Qed.

Theorem test_le3 :
  ~ (2 <= 1).
Proof.
  (* WORKED IN CLASS *)
  intros H. inversion H. inversion H1.  Qed.

Definition lt (n m:nat) := le (S n) m.

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

Inductive square_of : nat -> nat -> Prop :=
  sq : forall n:nat, square_of n (n * n).

Inductive next_nat (n:nat) : nat -> Prop :=
  | nn : next_nat n (S n).

Inductive next_even (n:nat) : nat -> Prop :=
  | ne_1 : ev (S n) -> next_even n (S n)
  | ne_2 : ev (S (S n)) -> next_even n (S (S n)).

Inductive total_relation (n m:nat) : Prop :=
  | con_total_relation : total_relation n m.

Inductive empty_relation (n m : nat) : Prop :=
  .

Module R.

Inductive R : nat -> nat -> nat -> Prop :=
   | c1 : R 0 0 0
   | c2 : forall m n o, R m n o -> R (S m) n (S o)
   | c3 : forall m n o, R m n o -> R m (S n) (S o)
   | c4 : forall m n o, R (S m) (S n) (S (S o)) -> R m n o
   | c5 : forall m n o, R m n o -> R n m o.

Theorem hoge : R 1 1 2.
Proof.
  apply c2. apply c3. apply c1. Qed.

Lemma R_plus : forall (m n o : nat),
  R m n o -> m + n = o.
Proof.
  intros.
  induction H.
  reflexivity. simpl. rewrite IHR. reflexivity.
  rewrite plus_comm. simpl. rewrite plus_comm. rewrite IHR. reflexivity.
  simpl in IHR. rewrite plus_comm in IHR. simpl in IHR. inversion IHR. apply plus_comm.
  rewrite plus_comm. apply IHR.
Qed.

Theorem hogee : ~ R 2 2 6.
Proof.
  unfold not. intros. apply R_plus in H. inversion H.
Qed.

Lemma R_plus' : forall(n m : nat),
  R n m (n+m).
Proof.
  intros.
  induction n as [| n'].
    Case "n = 0".
      induction m as [| m'].
        SCase "m = 0". apply c1.
        SCase "m = S m'". apply c3. apply IHm'.
    Case "n = S n'".
      induction m as [| m'].
        SCase "m = 0". rewrite plus_0_r.
          apply c2. simpl in IHn'.
          rewrite plus_0_r in IHn'.
          apply IHn'.
        SCase "m = S m'". simpl. apply c2. apply IHn'.
Qed.

Theorem R_fact : forall (m n o : nat),
  R m n o <-> m+n = o.
Proof.
  intros. unfold iff. split.
  Case "->". apply R_plus.
  Case "<-". intros. rewrite <- H. apply R_plus'.
Qed.

End R.

(*all_forallb*)

Inductive all (X : Type) (P : X -> Prop) : list X -> Prop :=
  | conallnil : all X P []
  | conall : forall(h : X) (t : list X),
             P h -> all X P t -> all X P (h::t)
.

Fixpoint forallb {X : Type} (test : X -> bool) (l : list X) : bool :=
  match l with
    | [] => true
    | x :: l' => andb (test x) (forallb test l')
  end.

Theorem forallb_prop :
  forall (X : Type) (test : X -> bool) (l : list X),
    forallb test l = true
    <-> all X (fun(x:X) => test x = true) l.
Proof.
  intros. split.
  Case "->".
    intros.
    induction l as [| h t].
      SCase "l = []". apply conallnil.
      SCase "l = h::t".
        simpl in H.
        apply conall.
        apply andb_true_elim1 in H.
        apply H.
        apply andb_true_elim2 in H.
        apply IHt.
        apply H.
  Case "<-".
    intros.
    induction H.
      SCase "nil". reflexivity.
      SCase "h::t".
        simpl. rewrite H. rewrite IHall. reflexivity.
Qed.

(*filter_challenge*)
(*filter_challenge2*)
(*no_repeats*)
Inductive appears_in {X:Type} (a:X) : list X -> Prop :=
  | ai_here : forall l, appears_in a (a::l)
  | ai_later : forall b l, appears_in a l -> appears_in a (b::l).

Lemma appears_in_app : forall {X:Type} (xs ys : list X) (x:X),
     appears_in x (xs ++ ys) -> appears_in x xs \/ appears_in x ys.
Proof.
  intros.
  remember (xs++ys).
  generalize dependent xs.
  generalize dependent ys.
  induction H.
  Case "ai_here".
    intros.
    destruct xs.
    SCase "[]".
      simpl in Heql.
      rewrite <- Heql.
      right.
      apply ai_here.
    SCase "x::xs".
      simpl in Heql.
      inversion Heql.
      left.
      apply ai_here.
  Case "ai_later".
    intros.
    destruct xs.
    SCase "[]".
      right.
      simpl in Heql.
      rewrite <- Heql.
      apply ai_later.
      apply H.
    SCase "x0::xs".
      inversion Heql.
      apply IHappears_in in H2.
      inversion H2.
      left.
      apply ai_later.
      apply H0.
      right.
      apply H0.
Qed.

Lemma app_appears_in_right : forall {X : Type} (xs ys : list X) (x:X),
  appears_in x ys -> appears_in x (xs++ys).
Proof.
  intros.
  inversion H.
  induction xs.
    apply ai_here.
    simpl. apply ai_later. apply IHxs.
  induction xs.
    simpl. apply ai_later. apply H0.
    simpl. apply ai_later. apply IHxs.
Qed.

Lemma app_appears_in : forall {X:Type} (xs ys : list X) (x:X),
     appears_in x xs \/ appears_in x ys -> appears_in x (xs ++ ys).
Proof.
  intros.
  inversion H.
  Case "left".
    induction H0.
    SCase "[]".
      simpl.
      apply ai_here.
      simpl.
      apply ai_later.
      apply IHappears_in.
      left.
      apply H0.
  Case "right".
    apply app_appears_in_right.
    apply H0.
Qed.

Definition disjoint {X:Type} (l1 l2 : list X) : Prop :=
  forall (x:X), appears_in x l1 -> appears_in x l2 -> False.

Inductive no_repeats {X:Type} : list X -> Prop :=
  | no_repeats_nil : no_repeats []
  | no_repeats_con : forall a l, no_repeats l ->
    (appears_in a l -> False) -> no_repeats (a::l).

Theorem app_no_repeats : forall {X:Type} (xs ys : list X),
  no_repeats (xs++ys) -> no_repeats xs /\ no_repeats ys.
Proof.
  intros.
  split.
  Case "right".
    remember (xs++ys).
    generalize dependent xs.
    generalize dependent ys.
    induction H.
    SCase "no_repeats_nil".
      intros.
      destruct xs.
        apply no_repeats_nil.
        inversion Heql.
    SCase "no_repeats_con".
      intros.
      destruct xs.
      SSCase "no_repeats_nil".
        apply no_repeats_nil.
      SSCase "no_repeats_con".
        apply no_repeats_con.
        inversion Heql.
        apply IHno_repeats with (ys:=ys).
        apply H3.
        inversion Heql.
        intros.
        apply H0.
        rewrite H3.
        apply app_appears_in.
        left.
        rewrite H2.
        apply H1.
  Case "left".
    remember (xs++ys).
    generalize dependent xs.
    generalize dependent ys.
    induction H.
    SCase "no_repeats_nil".
      intros.
      destruct xs.
      SSCase "nil".
        simpl in Heql.
        rewrite <- Heql.
        apply no_repeats_nil.
      SSCase "x::xs".
        inversion Heql.
    SCase "no_repeats_con".
      intros.
      destruct xs.
        SSCase "nil".
          simpl in Heql.
          rewrite <- Heql.
          apply no_repeats_con.
            apply H.
            apply H0.
        SSCase "x::xs".
        apply IHno_repeats with (xs:=(xs)).
        inversion Heql.
          reflexivity.
Qed.

Theorem O_le_n : forall n,
  0 <= n.
Proof.
  intros.
  induction n.
    apply le_n.
    apply le_S.
    apply IHn.
Qed.

Theorem n_le_m__Sn_le_Sm : forall n m,
  n <= m -> S n <= S m.
Proof.
  intros.
  induction m as [| m'].
    Case "0".
      inversion H.
      apply le_n.
    Case "S m'".
      inversion H.
        apply le_n.
        apply le_S.
        apply IHm'.
      apply H1.
Qed.

Theorem Sn_le_Sm__n_le_m : forall n m,
  S n <= S m -> n <= m.
Proof.
  intros n m.  generalize dependent n.  induction m.
  Case "m = 0".
    intros.
    inversion H.
      SCase "le_n".
        apply le_n.
      SCase "le_S".
        inversion H1.
  Case "m = S m".
    intros.
    inversion H.
      apply le_n.
      apply le_S.
      apply IHm.
      apply H1.
Qed.

Theorem le_plus_l : forall a b,
  a <= a + b.
Proof.
  intros.
  induction b.
  Case "0". rewrite plus_0_r. apply le_n.
  Case "S b".
    rewrite plus_comm. simpl. apply le_S.
   rewrite plus_comm. apply IHb.
Qed.

Theorem plus_lt : forall n1 n2 m,
  n1 + n2 < m ->
  n1 < m /\ n2 < m.
Proof.
  unfold "<".
  intros.
  split.
  Case "left".
    induction H.
    apply n_le_m__Sn_le_Sm.
    apply le_plus_l.
    apply le_S.
    apply IHle.
  Case "right".
    induction H.
    apply n_le_m__Sn_le_Sm.
    rewrite plus_comm.
    apply le_plus_l.
    apply le_S.
    apply IHle.
Qed.

Theorem lt_S : forall n m,
  n < m ->
  n < S m.
Proof.
  unfold "<".
  intros.
  apply le_S.
  apply H.
Qed.

Theorem ble_nat_true : forall n m,
  ble_nat n m = true -> n <= m.
Proof.
  intros n m H.
  generalize dependent m.
  induction n.
  Case "0".
    intros.
    assert(m = 0+m). reflexivity.
    rewrite H0.
    apply le_plus_l.
  Case "S n".
    intros.
    destruct m.
    SCase "0". inversion H. simpl in H.
    SCase "S m".
      apply n_le_m__Sn_le_Sm.
      apply IHn.
      apply H.
Qed.

Theorem ble_nat_n_Sn_false : forall n m,
  ble_nat n (S m) = false ->
  ble_nat n m = false.
Proof.
  intros.
  generalize dependent m.
  induction n as [| n'].
    Case "0". intros. simpl in H. inversion H.
    Case "S n".
      intros.
      destruct m as [| m'].
      SCase "0". reflexivity.
      SCase "S m". simpl. apply IHn'. apply H.
Qed.

Theorem ble_nat_refl : forall n:nat,
  true = ble_nat n n.
Proof.
  intros.
  induction n as [| n'].
    reflexivity.
    simpl.
    apply IHn'.
Qed.

Theorem ble_nat_false : forall n m,
  ble_nat n m = false -> ~(n <= m).
Proof.
  unfold "~".
  intros.
  induction H0.
    Case "le_n".
      rewrite <- ble_nat_refl in H.
      inversion H.
    Case "le_S".
      apply IHle.
      apply ble_nat_n_Sn_false.
      apply H.
Qed.

Inductive nostutter : list nat -> Prop :=
  | nostutter_nil : nostutter []
  | nostutter_one : forall n:nat, nostutter [n]
  | nostutter_mul : forall (n h : nat) (t:list nat),
                      nostutter (h::t) -> n<>h ->
                      nostutter (n::h::t).

Example test_nosutter_1 : nostutter [3,1,4,1,5,6].
Proof. repeat constructor; apply beq_false_not_eq; auto. Qed.

Example test_nostutter_2:  nostutter [].
Proof. repeat constructor; apply beq_false_not_eq; auto. Qed.

Example test_nostutter_3:  nostutter [5].
Proof. repeat constructor; apply beq_false_not_eq; auto. Qed.

Example test_nostutter_4: not (nostutter [3,1,1,4]).
Proof. intro.
repeat match goal with
  h: nostutter _ |- _ => inversion h; clear h; subst
end.
contradiction H5; auto. Qed.

Lemma app_length : forall {X:Type} (l1 l2 : list X),
  length (l1 ++ l2) = length l1 + length l2.
Proof.
  intros.
  Print "++".
  induction l1.
  Case "nil".
    reflexivity.
  Case "x::l1".
    simpl. SearchAbout (S _ = S _).
    apply eq_S.
    apply IHl1.
Qed.

Lemma appears_in_app_split : forall {X:Type} (x:X) (l:list X),
  appears_in x l ->
  exists l1, exists l2, l = l1 ++ (x::l2).
Proof.
  intros.
  induction H.
  Case "ai_here".
    apply ex_intro with (witness := nil).
    apply ex_intro with (witness := l).
    reflexivity.
  Case "ai_later".
    inversion IHappears_in.
    inversion H0.
    rewrite H1.
    apply ex_intro with (witness:=b::witness).
    apply ex_intro with (witness:=witness0).
    reflexivity.
Qed.

Inductive repeats {X:Type} : list X -> Prop :=
  | repeats_here : forall (a:X) (l:list X),
                   appears_in a l -> repeats (a::l)
  | repeats_later : forall (b:X) (l:list X),
                    repeats l -> repeats (b::l).

Theorem Sn_lt_Sn__n_lt_m : forall (n m : nat),
  S n < S m -> n < m.
Proof.
  unfold "<".
  intros. apply Sn_le_Sm__n_le_m. apply H.
Qed.

Lemma lt_irrefl : forall n, ~ n < n.
Proof.
 induction n.
  intro. inversion H.

  intro. destruct IHn.
  apply Sn_le_Sm__n_le_m. apply H.
Qed.

Lemma lt_not_le: forall n m : nat, n < m -> ~ m <= n.
Proof.
 intros.
 induction H.
  apply lt_irrefl.

  intro. destruct IHle. inversion H0.
   apply le_S. apply le_n.

   rewrite <- H2 in H0. apply le_S. apply Sn_le_Sm__n_le_m. apply H0.
Qed.

Lemma bag_remove : forall {X:Type} (l1 l2 l3 : list X) (x:X),
  ~(appears_in x l1) ->
  (forall (v:X), appears_in v (x::l1) -> appears_in v (l2++(x::l3))) ->
  (forall (v:X), appears_in v l1 -> appears_in v (l2++l3)).
Proof.
  intros.
  assert (appears_in v (l2++x::l3) -> appears_in v (l2++l3)).
    Case "Proof of Assertion".
    intros. apply app_appears_in. apply appears_in_app in H2.
    inversion H2.
      SCase "left". left. apply H3.
      SCase "right". right. inversion H3.
        rewrite H5 in H1. apply H in H1. inversion H1.
        apply H5.
  apply H2. apply H0. apply ai_later. apply H1.
Qed.

Theorem pigeonhole_principle: forall {X:Type} (l1 l2:list X),
  excluded_middle ->
  (forall x, appears_in x l1 -> appears_in x l2) ->
  length l2 < length l1 ->
  repeats l1.
Proof.
  unfold excluded_middle.
  intros X l1. induction l1.
  SCase "[]".
    intros.
    inversion H1.
  SCase "x::l1".
    intros.
    assert(appears_in x l2). apply H0. apply ai_here.
    assert (appears_in x l1 \/ ~(appears_in x l1)).
      apply H with (P:=(appears_in x l1)).
    inversion H3.
    SSCase "appears_in x l1".
      apply repeats_here.
      apply H4.
    SSCase "~appears_in x l1".
      apply repeats_later.
      apply appears_in_app_split in H2.
      inversion H2.
      inversion H5.
      apply IHl1 with (l2:=witness++witness0).
      apply H.
      apply bag_remove with (x0:=x).
        apply H4. rewrite <- H6. apply H0.
      assert (S(length(witness++witness0)) = length(witness++x::witness0)).
        SSSCase "Proof of Assertion".
        rewrite app_length.
        rewrite app_length with (l4:=x::witness0).
        simpl. rewrite plus_n_Sm. reflexivity.
    apply Sn_lt_Sn__n_lt_m.
    rewrite H7.
    rewrite <- H6.
    apply H1.
Qed.

Print nat_ind. Print nat_rect.

Definition nat_ind2 :
    forall (P : nat -> Prop),
    P 0 ->
    P 1 ->
    (forall n : nat, P n -> P (S(S n))) ->
    forall n : nat , P n :=
       fun P => fun P0 => fun P1 => fun PSS =>
          fix f (n:nat) := match n return P n with
                             0 => P0
                           | 1 => P1
                           | S (S n') => PSS n' (f n')
                          end.

Print nat_ind.

Lemma even_ev' : forall n, even n -> ev n.
Proof.
 intros.
 induction n as [ | |n'] using nat_ind2.
  Case "even 0".
    apply ev_0.
  Case "even 1".
    inversion H.
  Case "even (S(S n'))".
    apply ev_SS.
    apply IHn'.  unfold even.  unfold even in H.  simpl in H. apply H.
Qed.


(** * ADT: Abstract data types *)
Require Import Omega.

(** Let's consider the concept of lookup tables, indexed by keys that are
   numbers, mapping those keys to values of arbitrary (parametric) type.
   We can express this in Coq as follows: *)

Module Type TABLE.
 Parameter V: Type.
 Parameter default: V.
 Parameter table: Type.
 Definition key := nat.
 Parameter empty: table.
 Parameter get: key -> table -> V.
 Parameter set: key -> V -> table -> table.
 Axiom gempty: forall k,   (* get-empty *)
       get k empty = default.
 Axiom gss: forall k v t,      (* get-set-same *)
      get k (set k v t) = v.
 Axiom gso: forall j k v t,    (* get-set-other *)
      j <> k -> get j (set k v t) = get j t.
End TABLE.

(** This means:  in any [Module] that satisfies this [Module Type],
   there's a type [table] of lookup-tables, a type [V] of values,
   and operators [empty], [get], [set] that satisfy the axioms
   [gempty], [gss], and [gso].

  It's easy to make an implementation of [TABLE], using [Maps].
  Just for example, let's choose [V] to be [Type]. *)

Require Import Maps.

Module MapsTable <: TABLE.
 Definition V := Type.
 Definition default: V := Prop.
 Definition table := total_map V.
 Definition key := nat.
 Definition empty : table := t_empty default.
 Definition get (k: key) (m: table) : V := m (Id k).
 Definition set (k: key) (v: V) (m: table) : table :=
    t_update m (Id k) v.
 Theorem gempty: forall k, get k empty = default.
   Proof. intros. reflexivity. Qed.
 Theorem gss: forall k v t,  get k (set k v t) = v.
   Proof. intros. unfold get, set. apply t_update_eq. Qed.
 Theorem gso: forall j k v t, j<>k -> get j (set k v t) = get j t.
   Proof. intros. unfold get, set. apply t_update_neq.
       congruence.
   Qed.
End MapsTable.

(** In summary:  to make a [Module] that implements a [Module Type],
   you need to provide a [Definition] or [Theorem] in the [Module], whose type
   matches the corresponding [Parameter] or [Axiom] in the [Module Type]. *)

(** Now, let's calculate: put 1 and then 3 into a map, then lookup 1. *)

Eval compute in MapsTable.get 1 (MapsTable.set 3 unit (MapsTable.set 1 bool MapsTable.empty)).
 (* = bool *)

(** An _Abstract Data Type_ comprises:
    - A _type_ with a hidden representation (in this case, [t]).
    - Interface functions that operate on that type ([empty], [get], [set]).
    - Axioms about the interaction of those functions ([gempty], [gss], [gso]).
*)

(** So, [MapsTable] is an implementation of the [TABLE] abstract type.

   The problem with [MapsTable] is that the [Maps] implementation is
   very inefficient: linear time per [get] operation. If you do a sequence
   of [N] [get] and [set] operations, it can take time quadratic in [N].
   For a more efficient implementation, let's use our search trees. *)

Require Import SearchTree.

Module TreeTable <: TABLE.
 Definition V := Type.
 Definition default : V := Prop.
 Definition table := tree V.
 Definition key := nat.
 Definition empty : table := empty_tree V.
 Definition get (k: key) (m: table) : V := lookup V default k m.
 Definition set (k: key) (v: V) (m: table) : table :=
     insert V k v m.
 Theorem gempty: forall k, get k empty = default.
   Proof. intros. reflexivity. Qed.

 Theorem gss: forall k v t,  get k (set k v t) = v.
   Proof. intros. unfold get, set.
     destruct (unrealistically_strong_can_relate V default t)
        as [cts H].
     assert (H0 := insert_relate V default k v t cts H).
     assert (H1 := lookup_relate V default k _ _ H0).
    rewrite H1. apply t_update_eq.
   Qed.

(** **** Exercise: 3 stars (TreeTable_gso)  *)
(** Prove this using techniques similar to the proof of [gss] just above. *)

 Theorem gso: forall j k v t,  j<>k -> get j (set k v t) = get j t.
   Proof.
 (* FILL IN HERE *) Admitted.
(** [] *)
End TreeTable.

(** But suppose we don't have an unrealistically strong can-relate theorem?
   Remember the type of the "ordinary" can_relate: *)

Check can_relate.
  (*  : forall (V : Type) (default : V) (t : tree V),
       SearchTree V t ->
       exists cts : total_map V, Abs V default t cts *)

(** This requires that [t] have the [SearchTree] property, or in general,
   any value of type [table] should be well-formed, that is, should satisfy
   the representation invariant.  We must ensure that  the client of an ADT
   cannot "forge" values, that is, cannot coerce the representation type into
   the abstract type; especially ill-formed values of the representation type.
   This "unforgeability" is enforced in some real programming languages:
   ML (Standard ML or Ocaml) with its module system; Java, whose Classes
   have "private variables" that the client cannot see.
*)

(* ================================================================= *)
(** ** A brief excursion into dependent types *)
(**
   We can enforce the representation invariant in Coq using dependent types.
   Suppose [P] is a predicate
   on type [A], that is, [P: A -> Prop].  Suppose [x] is a value of type [A],
   and [proof: P x] is the name of the theorem that [x] satisfies [P].
   Then [ (exist x, proof) ] is a "package" of two things: [x], along with the
   proof of [P(x)].  The type of [(exists x, proof)] is written as [{x | P x}].
*)

Check exist. (* forall {A : Type} (P : A -> Prop) (x : A),
                 P x -> {x | P x}  *)
Check proj1_sig. (* forall {A : Type} {P : A -> Prop},
                 {x | P x} -> A *)
Check proj2_sig. (* forall (A : Type) {P : A -> Prop}
                 (e : {x | P x}),
                 P (proj1_sig e) *)

(** We'll apply that idea to search trees.  The type [A] will be [tree V].
  The predicate [P(x)] will be [SearchTree(x)]. *)

Module TreeTable2 <: TABLE.
 Definition V := Type.
 Definition default : V := Prop.
 Definition table := {x | SearchTree V x}.
 Definition key := nat.
 Definition empty : table :=
   exist (SearchTree V) (empty_tree V) (empty_tree_SearchTree V).
 Definition get (k: key) (m: table) : V :=
          (lookup V default k (proj1_sig m)).
 Definition set (k: key) (v: V) (m: table) : table :=
   exist (SearchTree V) (insert V k v (proj1_sig m))
          (insert_SearchTree _ _ _ _ (proj2_sig m)).

 Theorem gempty: forall k, get k empty = default.
   Proof. intros. reflexivity. Qed.

 Theorem gss: forall k v t,  get k (set k v t) = v.
  Proof. intros. unfold get, set.
    unfold table in t.

(** Now: [t] is a package with two components:
     The first component is a tree, and the second component is
     a proof that the first component has the SearchTree property.
    We can destruct [t] to see that more clearly. *)

    destruct t as [a Ha].
    (* Watch what this [simpl] does: *)
    simpl.
    (* Now we can use [can_relate] instead of [unrealistically_strong_can_relate]: *)
    destruct (can_relate V default a Ha) as [cts H].
    pose proof (insert_relate V default k v a cts H).
    pose proof (lookup_relate V default k _ _ H0).
    rewrite H1. apply t_update_eq.
  Qed.

(** **** Exercise: 3 stars (TreeTable_gso)  *)
(** Prove this using techniques similar to the proof of [gss] just above;
     don't use [unrealistically_strong_can_relate]. *)

 Theorem gso: forall j k v t,  j<>k -> get j (set k v t) = get j t.
   Proof.
 (* FILL IN HERE *) Admitted.
(** [] *)
End TreeTable2.

(* ================================================================= *)
(** ** End of the brief excursion into dependent types *)

(* ################################################################# *)
(** * Summary of Abstract Data Type proofs: *)

Section ADT_SUMMARY.
Variable V: Type.
Variable default: V.

(** Step 1.  Define a _representation invariant_.
  (In the case of search trees,
  the representation invariant is the [SearchTree] predicate.)
  Prove that each operation on the data type _preserves_ the
  representation invariant.  For example: *)

Check (empty_tree_SearchTree V).
  (*  SearchTree V (empty_tree V) *)
Check (insert_SearchTree V).
  (* forall (k : key) (v : V) (t : tree V),
       SearchTree V t -> SearchTree V (insert V k v t) *)

(** Notice two things:  Any operator (such as [insert]) that takes a [tree] _parameter_
   can _assume_ that the parameter satisfies the representation invariant.
   That is, the [insert_SearchTree] theorem takes a premise, [SearchTree V t].

   Any operator that produces a [tree] _result_ must prove that the result
   satisfies the representation invariant.  Thus, the conclusions,
   [SearchTree V (empty_tree V)]  and  [SearchTree V (empty_tree V)]
   of the two theorems above.

   Finally, any operator that produces a result of "base type", has no obligation
   to prove that the result satisfies the representation invariant; that wouldn't
   make any sense anyway, because the types wouldn't match.  That is,
   there's no "lookup_SearchTree" theorem, because [lookup] doesn't
   return a result that's a [tree].

   Step 2.  Define an _abstraction relation_.
     (In the case of search trees, it's the [Abs] relation.
     This relates the data structure to some mathematical
     value that is (presumably) simpler to reason about. *)

Check (Abs V default).  (* tree V -> total_map V -> Prop *)

(** For each operator, prove that:  assuming each [tree] argument satisfies
    the representation invariant _and_ the abstraction relation, prove that
    the results also satisfy the appropriate abstraction relation. *)

Check (empty_tree_relate V default). (*
       Abs V default (empty_tree V) (t_empty default)    *)
Check (lookup_relate' V default). (* forall k t cts,
       SearchTree V t ->
       Abs V default t cts ->
       lookup V default k t = cts (Id k)  *)
Check (insert_relate' V default). (*     : forall k v t cts,
       SearchTree V t ->
       Abs V default t cts ->
       Abs V default (insert V k v t) (t_update cts (Id k) v) *)

(** Step 3.  Using the representation invariant and the abstraction relation,
    prove that all the axioms of your ADT are valid.  For example... *)

Check TreeTable2.gso. (*
      : forall (j k : TreeTable2.key) (v : TreeTable2.V)
         (t : TreeTable2.table),
       j <> k ->
       TreeTable2.get j (TreeTable2.set k v t) = TreeTable2.get j t  *)

End ADT_SUMMARY.

(* ################################################################# *)
(** * Exercise in Data Abstraction *)
(** The rest of this chapter is optional. *)

Require Import List.
Import ListNotations.

(** Here's the Fibonacci function. *)

Fixpoint fibonacci (n: nat) :=
 match n with
 | 0 => 1
 | S i => match i with 0 => 1 | S j => fibonacci i + fibonacci j end
 end.

Eval compute in map fibonacci [0;1;2;3;4;5;6].

(** Here's a silly little program that computes the Fibonacci function. *)

Fixpoint repeat {A} (f: A->A) (x: A) n :=
 match n with O => x | S n' => f (repeat f x n') end.

Definition step (al: list nat) : list nat :=
 List.cons (nth 0 al 0 + nth 1 al 0) al.

Eval compute in map (repeat step [1;0;0]) [0;1;2;3;4;5].

Definition fib n := nth 0 (repeat step [1;0;0] n) 0.

Eval compute in map fib [0;1;2;3;4;5;6].

(** Here's a strange "List" module. *)

Module Type LISTISH.
 Parameter list: Type.
 Parameter create : nat -> nat -> nat -> list.
 Parameter cons: nat -> list -> list.
 Parameter nth: nat -> list -> nat.
End LISTISH.

Module L <: LISTISH.
 Definition list := (nat*nat*nat)%type.
 Definition create (a b c: nat) : list := (a,b,c).
 Definition cons (i: nat) (il : list) := match il with (a,b,c) => (i,a,b) end.
 Definition nth (n: nat) (al: list) :=
   match al with (a,b,c) =>
      match n with 0 => a | 1 => b | 2 => c | _ => 0 end
   end.
End L.

Definition sixlist := L.cons 0 (L.cons 1 (L.cons 2 (L.create 3 4 5))).

Eval compute in map (fun i => L.nth i sixlist) [0;1;2;3;4;5;6;7].

(** Module [L] implements _approximations_ of lists: it can remember
    the first three elements, and forget the rest.  Now watch: *)

Definition stepish (al: L.list) : L.list :=
 L.cons (L.nth 0 al + L.nth 1 al) al.

Eval compute in map (repeat stepish (L.create 1 0 0)) [0;1;2;3;4;5].

Definition fibish n := L.nth 0 (repeat stepish  (L.create 1 0 0) n).

Eval compute in map fibish [0;1;2;3;4;5;6].

(** This little theorem may be useful in the next exercise. *)

Lemma nth_firstn:
  forall A d i j (al: list A), i<j -> nth i (firstn j al) d = nth i al d.
Proof.
induction i; destruct j,al; simpl; intros; auto; try omega.
apply IHi. omega.
Qed.

(** **** Exercise: 4 stars, optional (listish_abstraction)  *)
(** In this exercise we will not need a _representation invariant_.
    Define an abstraction relation: *)

Inductive L_Abs: L.list -> List.list nat -> Prop :=
 (* FILL IN HERE *)
 .

Definition O_Abs al al' := L_Abs al al'.

(* State these theorems using O_Abs, not L_Abs.
   You'll see why below, at "Opaque". *)
Lemma create_relate : True.  (* change this line appropriately *)
(* FILL IN HERE *) Admitted.

Lemma cons_relate : True.  (* change this line appropriately *)
(* FILL IN HERE *) Admitted.

Lemma nth_relate : True.  (* change this line appropriately *)
(* FILL IN HERE *) Admitted.

(** Now, we will make these operators opaque.  Therefore, in the rest of
   the proofs in this exercise, you will not unfold their definitions.  Instead,
   you will just use the theorems [create_relate], [cons_relate], [nth_relate]. *)

Opaque L.list.
Opaque L.create.
Opaque L.cons.
Opaque L.nth.
Opaque O_Abs.

Lemma step_relate:
  forall al al',
   O_Abs al al' ->
   O_Abs (stepish al) (step al').
Proof.
(* FILL IN HERE *) Admitted.

Lemma repeat_step_relate:
 forall n al al',
 O_Abs al al' ->
 O_Abs (repeat stepish al n) (repeat step al' n).
Proof.
(* FILL IN HERE *) Admitted.

Lemma fibish_correct: forall n, fibish n = fib n.
Proof.  (* No induction needed in this proof! *)
(* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars, optional (fib_time_complexity)  *)
(** Suppose you run these three programs call-by-value, that is,
     as if they were ML programs.
    [fibonacci N]
    [fib N]
    [fibish N]
  What is the asymptotic time complexity (big-Oh run time) of each,
  as a function of N?  Assume that the [plus] function runs in constant time.
  You can use terms like "linear," "N log N," "quadratic," "cubic," "exponential."
  Explain your answers briefly.

  fibonacci:  (* fill in here *)
  fib:  (* fill  in here *)
  fibish: (* fill in here *)

*)
(** [] *)


Require Import Notations
  Coq.Lists.List
  Coq.Arith.Arith
  Coq.Arith.Compare_dec
  Coq.Bool.Sumbool
  Coq.Bool.Bool
  Coq.ZArith.ZArith
  Coq.Logic.FinFun
  Coq.Program.Basics
  Coq.Logic.FunctionalExtensionality
  Psatz
  ListLemma
  Candidates.

Import ListNotations.
Open Scope Z.

Notation "'existsT' x .. y , p" :=
  (sigT (fun x => .. (sigT (fun y => p)) ..))
    (at level 200, x binder, right associativity,
     format "'[' 'existsT' '/ ' x .. y , '/ ' p ']'") : type_scope.

Module Margin (Import Cand : Candidate).

  Section Marg.
    (* marg is the margin in Schulze counting, i.e. marg c d is the number of
      voters that perfer c over d. The existence of the margin function
      is assumed for the specification of Schulze Voting and will be
      constructed from incoming ballots later *)
      Variable marg : cand -> cand -> Z.

      (* prop-level path *)
      Inductive Path (k : Z) : cand -> cand -> Prop :=
      | unit c d : marg c d >= k -> Path k c d
      | cons c d e : marg c d >= k -> Path k d e -> Path k c e.

      (* winning condition of Schulze Voting *)
      Definition wins_prop (c: cand) := forall d: cand, exists k: Z,
        Path k c d /\ (forall l, Path l d c -> l <= k).

      (* dually, the notion of not winning: *)
      Definition loses_prop (c : cand) := exists k: Z, exists  d: cand,
        Path k d c /\ (forall l, Path l c d -> l < k).

      (** Section 3: A Scrutiny Sheet for the Schulze Method **)

      (* boolean function that determines whether the margin between a
        pair  of candidates is below a given integer *)
      Definition marg_lt (k : Z) (p : (cand * cand)) :=
        Zlt_bool (marg (fst p) (snd p)) k.

      (* definition of the (monotone) operator W_k that defines coclosed sets *)
      Definition W (k : Z) (p : cand * cand -> bool) (x : cand * cand) :=
        andb (marg_lt k x)
        (forallb (fun m => orb (marg_lt k (fst x, m)) (p (m, snd x))) cand_all).

      (* k-coclosed predicates *)
      Definition coclosed (k : Z) (p : (cand * cand) -> bool) :=
        forall x, p x = true -> W k p x = true.

      (* type-level path to replace prop-level path *)
      Inductive PathT (k: Z) : cand -> cand -> Type :=
      | unitT c d : marg c d >= k -> PathT k c d
      | consT c d e : marg c d >= k -> PathT k d e -> PathT k c e.

      (* type-level winning condition in Schulze counting *)
      Definition wins_type c :=
        forall d : cand, existsT (k : Z),
        ((PathT k c d) * (existsT (f : (cand * cand) -> bool),
          f (d, c) = true /\ coclosed (k + 1) f))%type.

      (* dually, the type-level condition for non-winners *)
      Definition loses_type (c : cand) :=
        existsT (k : Z) (d : cand), ((PathT k d c) *
          (existsT (f : (cand * cand) -> bool), f (c, d) = true /\ coclosed k f))%type.

      (* type-level notions of winning and losing are equivalent *)
      (* auxilary lemmas needed for the proof of equivalence     *)
      (* search for wins_prop_type and wins_type_prop for the    *)
      (* statement and proof of equivalence, dually for losing.  *)

      (* type-level paths allow to construct evidence for the existence of paths *)
      Lemma path_equivalence : forall c d k , PathT k c d -> Path k c d.
      Proof.
        refine
          (fix F c d k H {struct H}:=
             match H with
            | unitT _ cf df mrg => unit _ cf df mrg
            | consT _ cf df ef mrg t => cons _ cf df ef mrg (F _ _ _ t)
            end).
      Qed.

      (* mp stands for midpoint and the lemma below shows that for a pair of candidates (a, c)
         with x = (a, c) in W_k p, and a putative midpoint b, we have that marg a b < k or p b c. *)
      Lemma mp_log : forall (k : Z) (x : cand * cand) (p : cand * cand -> bool),
        (forallb (fun m => orb (marg_lt k (fst x, m)) (p (m, snd x))) cand_all) = true ->
        forall b, p (b, snd x) = true \/ marg (fst x) b < k.
      Proof.
        intros k x p H b.
        assert (Hin : In b cand_all) by  apply cand_fin.
        pose proof (proj1 (forallb_forall _ cand_all) H b Hin) as Hp. simpl in Hp.
        apply orb_true_iff in Hp; destruct Hp as [Hpl | Hpr]; destruct x as (a, c); simpl in *.
        + right; apply Zlt_is_lt_bool; auto.
        + left;auto.
      Qed.

      (* all elements (x, y) in a k-coclosed set can only be joined by a path of strenght < k *)
      Lemma coclosed_path : forall k f, coclosed k f -> forall s x y,
          Path s x y -> f (x, y) = true -> s < k.
      Proof.
        intros k f Hcc x s y p. induction p.

        (* unit path *)
        + intros Hin; specialize (Hcc (c, d) Hin); apply andb_true_iff in Hcc;
          destruct Hcc as [Hccl Hccr]; apply Zlt_is_lt_bool in Hccl; simpl in Hccl;  lia.

      (* non unit path *)
        + intros Hin; specialize (Hcc (c, e) Hin); apply andb_true_iff in Hcc;
          destruct Hcc as [Hccl Hccr]; unfold marg_lt in Hccl; simpl in Hccl.
          assert (Hmp : forall m, f (m, (snd (c, e))) = true \/ marg (fst (c, e)) m < k)
            by (apply mp_log; auto); simpl in Hmp.
          specialize (Hmp d). destruct Hmp; [intuition | lia].
      Qed.

      Definition listify (m : cand -> cand -> Z) :=
        map (fun s => (fst s, snd s, m (fst s) (snd s))) (all_pairs cand_all).

      Lemma in_pairs : forall a b, In a cand_all -> In b cand_all -> In (a, b) (all_pairs cand_all).
      Proof.
        intros a b H1 H2. apply all_pairsin; auto.
      Qed.

      Fixpoint linear_search (c d : cand) l :=
        match l with
        | [] => marg c d
        | (c1, c2, k) :: t =>
          match dec_cand c c1, dec_cand d c2 with
          | left _, left _ => k
          | _, _ => linear_search c d t
          end
        end.

      Theorem equivalent_m : forall c d m, linear_search c d (listify m) = m c d.
      Proof.
        unfold listify.  intros c d m.
        assert (H1 : forall c1 c2, In (c1, c2) (all_pairs cand_all)).
        intros c1 c2. apply in_pairs; apply cand_fin.
        specialize (H1 c d).
        induction (all_pairs cand_all).
        + inversion H1.
        + simpl.
          destruct a as (a1, a2). simpl in *.
          destruct (dec_cand c a1).
          destruct (dec_cand d a2). subst. auto.
          destruct H1. inversion H. symmetry in H2. unfold not in n.
          specialize (n H2). inversion n.
          apply IHl. auto.
          destruct H1. inversion H. unfold not in n. symmetry in H1.
          specialize (n H1). inversion n.
          apply IHl. auto.
      Qed.

      Fixpoint M_old (n : nat) (c d : cand) : Z :=
        match n with
        | 0%nat => marg c d
        | S n' => Z.max (M_old n' c d)
          (maxlist (map (fun x : cand => Z.min (marg c x) (M_old n' x d)) cand_all))
        end.

      (* M is the iterated margin function and maps a pair of candidates c, d to the
        strength of the strongest path of length at most (n + 1) *)

      Fixpoint MM n :=
        match n with
        | O => listify marg
        | S n' =>
          let uu := MM n' in
          listify (fun c d =>
            let u := linear_search c d uu in
            let t := maxlist (map (fun x => Z.min (marg c x) (linear_search x d uu)) cand_all) in
            Z.max u t)
        end.

      Definition M n : cand -> cand -> Z :=
        let l := MM n in
        fun c d => linear_search c d l.

      Lemma M_M_new_equal : forall n c d , M n c d = M_old n c d.
      Proof.
        induction n. unfold M. simpl. intros c d. rewrite equivalent_m. auto.
        intros c d.  unfold M in *. simpl. rewrite equivalent_m.
        assert (Ht: maxlist (map (fun x : cand => Z.min (marg c x) (linear_search x d (MM n))) cand_all) =
                  maxlist (map (fun x : cand => Z.min (marg c x) (M_old n x d)) cand_all)).
        apply f_equal.

        induction cand_all. auto. simpl. pose proof (IHn a d).
        rewrite H. apply f_equal. auto.
        rewrite Ht. rewrite IHn. auto.
      Qed.

      (* partial correctness of iterated margin function: if the strength M n c d
        of the strongest path of length <= n+1 between c and d is at least s, then
        c and d can be joined by a type-level path of this strength *)
      Theorem iterated_marg_patht : forall n s c d, M n c d >= s -> PathT s c d.
      Proof.
        induction n.
        intros s c d H. constructor. unfold M in *. simpl in *. rewrite equivalent_m in H. auto.
        intros s c d H. unfold M in *. simpl in H. rewrite equivalent_m in H.
        unfold Z.max in H.
        destruct (linear_search c d (MM n)
                              ?= maxlist (map (fun x : cand => Z.min (marg c x) (linear_search x d (MM n))) cand_all)).
        apply IHn. auto.
        apply max_of_nonempty_list_type in H. destruct H as [x [H1 H2]].
        apply z_min_lb in H2. destruct H2.
        specialize (IHn _ _ _ H0). specialize (consT _ _ _ _ H IHn); auto.
        apply cand_not_nil.  apply dec_cand. apply IHn. assumption.
      Defined.

      (* as type level paths induce prop-level paths, the same as above also holds for prop-level
        paths *)
      Lemma iterated_marg_path : forall (n : nat) (s : Z) (c d : cand),
        M n c d >= s -> Path s c d.
      Proof.
        intros n s c d Hm.
        apply path_equivalence. apply iterated_marg_patht with (n := n).
        assumption.
      Qed.

      (* existence of a a path between c and d of strength s gives an interate of the
         iterated margin function with value at least s *)
      Lemma path_iterated_marg : forall (s : Z) (c d : cand),
          Path s c d -> exists n, M n c d >= s.
      Proof.
        intros s c d H.  induction H.
        exists 0%nat. unfold M. simpl. rewrite equivalent_m. auto. destruct IHPath.
        exists (S x). unfold M in *. simpl.  rewrite equivalent_m. apply z_max_lb. right.
        apply max_of_nonempty_list.
        apply cand_not_nil. apply dec_cand. exists d.
        split. pose proof (cand_fin d). auto.
        apply z_min_lb. split. auto. auto.
      Qed.

      (* monotonicity of the iterated margin function *)
      Lemma monotone_M : forall (n m : nat) c d, (n <= m)%nat  -> M n c d <= M m c d.
      Proof.
        intros n m c d H.  induction H; simpl; try lia.
        apply Z.ge_le. unfold M at 1. simpl. rewrite equivalent_m.
        apply z_max_lb with (m := M m c d).
        left. lia.
      Qed.

      (* Here, we view paths as lists of candidates, and str computes the strength of
        a path relative to the given margin function *)
      Fixpoint str c l d :=
        match l with
        | [] => marg c d
        | (x :: xs) => Z.min (marg c x)  (str x xs d)
        end.

      (* the iterated margin function is correct relative to the length of a path *)
      Lemma path_len_iterated_marg : forall k c d s l,
          (length l <= k)%nat -> str c l d >= s -> M k c d >= s.
      Proof.
        induction k. intros. assert ((length l <= 0)%nat -> l = []).
        { destruct l. intros. reflexivity.
          simpl in *. inversion H. }
        specialize (H1 H). subst. simpl in *. unfold M in *. simpl. rewrite equivalent_m. auto.
        intros. simpl in *. destruct l. simpl in *.
        unfold M in *. simpl.

        rewrite equivalent_m. apply z_max_lb.
        left. apply IHk with []. simpl. lia. simpl. auto.
        simpl in *. apply z_min_lb in H0. destruct H0.
        unfold M in *.  simpl.
        rewrite equivalent_m.
        apply z_max_lb. right. apply max_of_nonempty_list.
        apply cand_not_nil. apply dec_cand. exists c0. split. specialize (cand_fin c0). trivial.
        apply z_min_lb. split.
        lia. apply IHk with l. lia. lia.
      Qed.

      (* characterisation of the iterated margin function in terms of paths *)
      Lemma iterated_marg_char: forall k c d s,
          M k c d >= s <-> exists (l : list cand), (length l <= k)%nat /\ str c l d >= s.
      Proof.
        split. generalize dependent s. generalize dependent d.
        generalize dependent c. induction k. simpl. intros. exists []. simpl. intuition.
        unfold M in *. simpl in H. rewrite equivalent_m in H. auto.

        simpl. intros. unfold M in *. simpl in H.

        rewrite equivalent_m in H.  pose proof (proj1 (z_max_lb (M k c d) _ s) H).
        destruct H0.
        specialize (IHk c d s H0). destruct IHk as [l [H1 H2]]. exists l. lia. clear H.
        pose proof
            (max_of_nonempty_list _ cand_all cand_not_nil dec_cand s
                                  (fun x : cand => Z.min (marg c x) (M k x d))).
        destruct H. clear H1. specialize (H H0). destruct H as [e [H1 H2]].
        pose proof (proj1 (z_min_lb _ _ s) H2). destruct H.
        specialize (IHk e d s H3). destruct IHk as [l [H4 H5]].
        exists (e :: l). simpl. split. lia.
        apply z_min_lb. intuition.
        (* otherway *)
        intros. destruct H as [l [H1 H2]].
        pose proof (path_len_iterated_marg k c d s l H1 H2). lia.
      Qed.

      (* every path of strength >= s can be split into two paths of strength >= s *)
      Lemma path_split: forall c d a l1 l2 s,
          str c (l1 ++ a :: l2) d >= s <-> str c l1 a >= s /\ str a l2 d >= s.
      Proof.
        split. generalize dependent s. generalize dependent l2.
        generalize dependent a. generalize dependent d. generalize dependent c.
        induction l1; simpl; intros.
        apply z_min_lb in H. auto. apply z_min_lb in H. destruct H.
        assert ((marg c a) >= s /\ (str a l1 a0) >= s /\ str a0 l2 d >= s ->
                Z.min (marg c a) (str a l1 a0) >= s /\ str a0 l2 d >= s).
        { intros. destruct H1 as [H1 [H2 H3]]. split. apply z_min_lb. auto. auto. }
        apply H1. split. assumption. apply IHl1. assumption.
        (* other part *)
        generalize dependent s. generalize dependent l2.
        generalize dependent a. generalize dependent d. generalize dependent c.
        induction l1; simpl; intros. apply z_min_lb. auto.
        apply z_min_lb. destruct H. apply z_min_lb in H. destruct H.
        split. auto. apply IHl1. auto.
      Qed.

      (* cutting out a loop from a path does not decrease its strength *)
      Lemma path_cut: forall c d a l l1 l2 l3 s,
          l = l1 ++ a :: l2 ++ a :: l3 -> str c l d >= s -> str c (l1 ++ a :: l3) d >= s.
      Proof.
        intros. subst. apply path_split in H0. destruct H0.
        apply path_split in H0. destruct H0.
        pose proof (proj2 (path_split c d a l1 l3 s) (conj H H1)). auto.
      Qed.

      (* the iterated margin function stabilizes after n iterations, where n is the
        number of candidates. *)
      Lemma iterated_marg_stabilises: forall k n c d (Hn: (length cand_all = n)%nat),
          M (k + n) c d <= M n  c d.
      Proof.
        induction k using (well_founded_induction lt_wf). intros n c d Hn.
        remember (M (k + n) c d) as s.
        pose proof (Z.eq_le_incl _ _ Heqs). apply Z.le_ge in H0.
        pose proof (proj1 (iterated_marg_char _ _ _ _) H0). destruct H1 as [l [H1 H2]].
        (* number of candidates <= length Evote.cand_all \/ > length Evote.cand_all *)
        assert ((length l <= n)%nat \/ (length l > n)%nat) by lia.
        destruct H3 as [H3 | H3].
        pose proof (proj2 (iterated_marg_char n c d s)
                          (ex_intro (fun l => (length l <= n)%nat /\ str c l d >= s) l (conj H3 H2))). lia.
        (* length l > length Evote.cand_all and there are candidates. Remove the duplicate
          candidate *)
        rewrite <- Hn in H3. assert (covers cand cand_all l).
        { unfold covers. intros. pose proof (cand_fin x). assumption. }
        pose proof (list_split_dup_elem _ n cand_all dec_cand Hn l H3 H4).
        destruct H5 as [a [l1 [l2 [l3 H5]]]].
        pose proof (path_cut  _ _ _ _ _ _ _ _ H5 H2).
        remember (l1 ++ a :: l3) as l0.
        assert ((length l0 <= n)%nat \/ (length l0 > n)%nat) by lia.
        destruct H7.
        pose proof (iterated_marg_char n c d s). destruct H8.
        assert ((exists l : list cand, (length l <= n)%nat /\ str c l d >= s)).
        exists l0. intuition. specialize (H9 H10).  lia.
        rewrite Hn in H3.
        specialize (list_and_num _ _ _ H3); intros. destruct H8 as [p H8].
        specialize (list_and_num _ _ _ H7); intros. destruct H9 as [k' H9].
        assert ((length l0 < length l)%nat).
        { rewrite Heql0, H5.
          rewrite app_length. rewrite app_length.
          simpl. rewrite app_length. simpl.
          lia. }
        rewrite H9 in H10. rewrite H8 in H10.
        assert (((k' + n) < (p + n))%nat -> (k' < p)%nat) by lia.
        specialize (H11 H10). assert (k' < k)%nat by lia.
        specialize (H k' H12 n c d Hn).
        pose proof (iterated_marg_char (length l0) c d (str c l0 d)).
        destruct H13.
        assert ((exists l : list cand, (length l <= length l0)%nat /\ str c l d >= str c l0 d)).
        { exists l0. lia. }
        specialize (H14 H15). clear H13. rewrite <- H9 in H. lia.
      Qed.

      (* the iterated margin function reaches a fixpoint after n iterations, where
        n is the number of candidates *)
      Lemma iterated_marg_fp : forall (c d : cand) (n : nat),
          M n c d <= M (length cand_all) c d.
      Proof.
        intros c d n. assert ((n <= (length cand_all))%nat \/
                              (n >= (length cand_all))%nat) by lia.
        destruct H. apply monotone_M. assumption.
        remember ((length cand_all)) as v.
        assert ((n >= v)%nat -> exists p, (n = p + v)%nat).
        { intros. induction H. exists 0%nat. lia.
          assert ((v <= m)%nat -> (m >= v)%nat) by lia.
          specialize (H1 H). specialize (IHle H1). destruct IHle as [p H2].
          exists (S p). lia. }
        specialize (H0 H). destruct H0 as [p H0].
        subst. apply  iterated_marg_stabilises. auto.
      Qed.

      (* boolean valued function that determines election winners based on the
        (fixpoint of the) iterated margin function *)
      Definition c_wins c :=
        forallb (fun d => (M (length cand_all) d c) <=? (M (length cand_all) c d))
                cand_all.

      (* characterisation of c_wins returning true in terms of iterated margin function *)
      Lemma c_wins_true (c : cand) :
        c_wins c = true <-> forall d, M (length cand_all) d c <= M (length cand_all) c d.
      Proof.
        split; intros.
        unfold c_wins in H.
        pose proof
            (proj1 (forallb_forall
                      (fun d : cand => M (length cand_all) d c <=?
                                        M (length cand_all) c d) cand_all) H).
        pose proof (H0 d (cand_fin d)). simpl in H1.
        apply Zle_bool_imp_le. assumption.
        unfold c_wins. apply forallb_forall. intros x Hin.
        pose proof H x. apply Zle_imp_le_bool. assumption.
      Qed.

      (* characterisation of c_wins returning false in terms of the interated margin function *)
      Lemma c_wins_false (c : cand):
        c_wins c = false <-> exists d, M (length cand_all) c d < M (length cand_all) d c.
      Proof.
        split; intros. unfold c_wins in H.
        apply forallb_false in H. destruct H as [x [H1 H2]].
        exists x. apply Z.leb_gt in H2. lia.
        destruct H as [d H]. unfold c_wins. apply forallb_false.
        exists d. split. pose proof (cand_fin d). assumption.
        apply Z.leb_gt. lia.
      Qed.

      (* the propositional winning condition implies winning in terms of the interated margin
        function *)
      Lemma wins_prop_iterated_marg (c : cand): wins_prop c ->
                                                forall d, M (length cand_all) d c <= M (length cand_all) c d.
      Proof.
        intros. specialize (H d). destruct H as [k [H1 H2]].
        remember (M (length cand_all) d c) as s.
        apply Z.eq_le_incl in Heqs.
        apply Z.le_ge in Heqs.
        pose proof (iterated_marg_path _ _ _ _ Heqs). specialize (H2 s H).
        apply  path_iterated_marg in H1. destruct H1 as [n H1].
        pose proof (iterated_marg_fp c d n). lia.
      Qed.

      (* winning in terms of the iterated margin function gives the type-level winning condition *)
      Lemma iterated_marg_wins_type (c : cand): (forall d,
                                                    M (length cand_all) d c <= M (length cand_all) c d) ->
                                                wins_type c.
      Proof.
        (* rewrite it using refine tactic *)

        intros H d. specialize (H d).
        remember (M (length cand_all) c d) as s eqn:Heqs.
        apply Z.eq_le_incl in Heqs.
        apply Z.le_ge in Heqs. exists s.
        pose proof (iterated_marg_patht _ _ _ _ Heqs) as Hi.
        split.
        - intuition.
        - remember (M (length cand_all) d c) as r eqn:Heqr.
          exists (fun x => M (length cand_all) (fst x) (snd x) <=? r).
          split.
          + apply Z.leb_le. simpl. intuition.
          + intros x Hx. destruct x as (x, z).
            apply Z.leb_le in Hx. apply andb_true_iff.
            split.
            * apply Z.ltb_lt. simpl in *.
              clear Heqs. clear Heqr.
              induction (length cand_all); simpl in Hx. unfold M in Hx. simpl in Hx.
              rewrite equivalent_m in Hx.
              intuition.
              apply IHn. unfold M in Hx. simpl in Hx.
              rewrite equivalent_m in Hx.  apply Z.max_lub_iff in Hx. intuition.
            * apply forallb_forall. intros y Hy. apply orb_true_iff.
              simpl in *.
              assert (A : marg x y <= s \/ marg x y > s) by lia.
              destruct A as [A1 | A2].
              left. apply Z.ltb_lt. simpl. lia.
              right. apply Z.leb_le.
              assert (B : M (length cand_all) y z <= r \/ M (length cand_all) y z >= r + 1) by lia.
              destruct B as [B1 | B2].
              intuition.
              apply iterated_marg_path in B2.
              assert (A3 : marg x y >= r + 1) by lia.
              pose proof (cons _ _ _ _ A3 B2) as C.
              apply  path_iterated_marg in C. destruct C as [n C].
              pose proof (iterated_marg_fp x z n). lia.
      Defined.

      (* the type level winning condition can be reconstruced from *)
      (* propositional knowledge of winning *)
      Lemma wins_prop_type : forall c, wins_prop c -> wins_type c.
      Proof.
        intros c H. unfold wins_prop, wins_type in *.
        apply iterated_marg_wins_type. apply wins_prop_iterated_marg. auto.
      Qed.

      (* dually, the type-level information witnessing winners *)
      (* entails prop-level knowledge. *)
      Lemma wins_type_prop : forall c, wins_type c -> wins_prop c.
      Proof.
        intros c H. unfold wins_prop, wins_type in *. intros d.
        destruct (H d) as [k [H1 [f [H3 H4]]]].
        exists k. split. apply path_equivalence. auto.
        intros l H5. pose proof (coclosed_path _ _ H4).
        pose proof (H0 l _ _ H5 H3). lia.
      Qed.

      (* the losing condition in terms of the iterated margin function *)
      Lemma loses_prop_iterated_marg (c : cand):
        loses_prop c ->
        (exists d, M (length cand_all) c d < M (length cand_all) d c).
      Proof.
        intros. destruct H as [k [d [H1 H2]]].
        exists d. remember (M (length cand_all) c d)  as s.
        pose proof (Z.eq_le_incl _ _ Heqs) as H3.
        apply Z.le_ge in H3. apply iterated_marg_path in H3. specialize (H2 s H3).
        apply  path_iterated_marg in H1. destruct H1 as [n H1].
        pose proof (iterated_marg_fp d c n). lia.
      Qed.

      (* existential quantifiers over finite lists can be reified into Sigma-types for
        decidable properties *)
      Definition exists_fin_reify {A: Type} (P: A -> Prop):
        (forall a: A, {P a} + {~(P a)}) ->
        forall l: list A, (exists a, In a l /\ P a) -> existsT a, P a :=
        fun Pdec =>
          fix F l {struct l} :=
          match l  as m return ((exists a : A, In a m /\ P a) -> existsT a : A, P a) with
          | [] =>
            fun H : exists a : A, In a [] /\ P a =>
              (fun Hf : False => (fun X : existsT a : A,P a => X)
                                  match Hf return
                                        (existsT a : A,P a) with end)
                match H with
                | ex_intro _ a (conj Ha _) => (fun H1 : False => H1) match Ha return False with end
                end
          | h :: t => fun H =>
                        match (Pdec h) with
                        | left e => existT _ h e
                        | right r =>
                          F t
                            match H with
                            | ex_intro _ a (conj (or_introl e) Hpa) =>
                              (fun rr : ~ P a => False_ind (exists a1 : A, In a1 t /\ P a1) (rr Hpa))
                                (eq_ind h (fun hh : A => ~ P hh) r a e)
                            | ex_intro _ a (conj (or_intror rr as Hin) Hpa as a0) =>
                              ex_intro _ a (conj rr Hpa)
                            end
                        end
          end.

      (* reification of candidates given propositional existence *)
      Corollary reify_opponent (c: cand):
        (exists  d, M  (length cand_all) c d < M (length cand_all) d c) ->
        (existsT d, M  (length cand_all) c d < M (length cand_all) d c).
        refine (fun Hex  =>
                  (fun Hdec : forall d : cand,
                      {M (length cand_all) c d < M (length cand_all) d c} +
                      {~ M (length cand_all) c d < M (length cand_all) d c} =>
                    exists_fin_reify
                      _  Hdec cand_all
                      match Hex with
                      | ex_intro _ d Hex0 =>
                        ex_intro _ d (conj (cand_fin d) Hex0)
                      end)
                    (fun d : cand =>
                      let s := Z_lt_ge_bool (M (length cand_all) c d) (M (length cand_all) d c) in
                      let (b, P) := s in
                      (if b as bt
                          return
                          ((if bt
                            then M (length cand_all) c d < M (length cand_all) d c
                            else M (length cand_all) c d >= M (length cand_all) d c) ->
                            {M (length cand_all) c d < M (length cand_all) d c} +
                            {~ M (length cand_all) c d < M (length cand_all) d c})
                        then fun Pt => left Pt
                        else fun Pf => right (fun H => Pf H)) P)).
      Defined.

      (* reconstructon of the losing condition type-level losing from interated
        margin function *)
      Lemma iterated_marg_loses_type (c : cand) :
        (exists d, M (length cand_all) c d < M (length cand_all) d c) -> loses_type c.
      Proof.
        unfold loses_type. intros.
        assert (HE:  existsT d, M  (length cand_all) c d < M (length cand_all) d c).
        apply reify_opponent. assumption.
        destruct HE as [d HE].
        remember (M (length cand_all) d c) as s. exists s, d.
        split. assert (H1 : M (length cand_all) d c >= s) by lia.
        apply iterated_marg_patht in H1. auto.
        exists (fun x => M (length cand_all) (fst x) (snd x) <? s).
        simpl in *. split. apply Z.ltb_lt. lia.
        unfold coclosed. intros x; destruct x as (x, z); simpl in *.
        intros. apply Z.ltb_lt in H0. unfold W.
        apply andb_true_iff. split. unfold marg_lt. simpl. apply Z.ltb_lt.
        clear H. clear Heqs.
        induction (length cand_all). unfold M in *. simpl in *.  rewrite equivalent_m in H0.  lia.
        unfold M in H0.
        simpl in H0. rewrite equivalent_m in H0.
        apply Z.max_lub_lt_iff in H0. destruct H0. apply IHn. auto.
        unfold M in HE.
        simpl in HE. rewrite equivalent_m in HE.
        apply Z.max_lub_lt_iff in HE. destruct HE as [H1 H2]. assumption. assumption.

        apply forallb_forall. intros y Hy.
        apply orb_true_iff. unfold marg_lt. simpl.
        assert (marg x y < s \/ marg x y >= s) by lia.
        destruct H1. left. apply Z.ltb_lt. auto.
        right. apply Z.ltb_lt.
        assert (M (length cand_all) y z < s \/ M (length cand_all) y z >= s) by lia.
        destruct H2. auto.
        apply iterated_marg_path in H2.  pose proof (cons _ _ _ _ H1 H2).
        apply  path_iterated_marg in H3. destruct H3 as [n H3].
        pose proof (iterated_marg_fp x z n). lia.
      Defined.

      (* prop-level losing implies type-level losing *)
      Lemma loses_prop_type : forall c, loses_prop c -> loses_type c.
      Proof.
        intros c H. unfold loses_prop, loses_type in *. apply iterated_marg_loses_type.
        apply loses_prop_iterated_marg. auto.
      Qed.

      (* type-level losing implies prop-level losing *)
      Lemma loses_type_prop : forall c, loses_type c -> loses_prop c.
      Proof.
        intros c H. unfold loses_prop, loses_type in *.
        destruct H as [k [d [Hp [f [Hf Hc]]]]].
        exists k, d. split. apply path_equivalence. auto.
        intros l H. pose proof (coclosed_path k f Hc).
        pose proof (H0 l _ _ H Hf). lia.
      Qed.

      (* decidability of type-level winning *)
      Lemma wins_loses_type_dec : forall c, (wins_type c) + (loses_type c).
      Proof.
        intros c. destruct (c_wins c) eqn : c_wins_val.  left.
        unfold wins_type. apply  iterated_marg_wins_type. apply wins_prop_iterated_marg. intros d.
        pose proof (proj1 (forallb_forall _ cand_all) c_wins_val d (cand_fin d)).
        simpl in H. apply Zle_bool_imp_le in H. apply Z.le_ge in H.
        remember (M (length cand_all) d c) as s. apply iterated_marg_path in H.
        exists s. split. assumption.
        intros. rewrite Heqs. apply  path_iterated_marg in H0. destruct H0 as [n H0].
        apply Z.ge_le in H0. pose proof (iterated_marg_fp d c n). lia.
        right. apply iterated_marg_loses_type. unfold c_wins in c_wins_val.
        apply forallb_false_type in c_wins_val.
        destruct c_wins_val as [d [H1 H2]]. apply Z.leb_gt in H2. exists d. auto.
      Defined.

      (* aligning c_wins with type level evidence *)
      Lemma c_wins_true_type:
        forall c : cand, c_wins c = true <-> (exists x : wins_type c, wins_loses_type_dec c = inl x).
      Proof.
        split; intros. destruct (wins_loses_type_dec c) eqn:Ht. exists w. auto.
        pose proof (loses_type_prop c l). unfold loses_prop in H0.
        apply loses_prop_iterated_marg  in H0.
        pose proof (proj1 (c_wins_true c) H). destruct H0. specialize (H1 x). lia.
        destruct H. pose proof (wins_type_prop c x). unfold wins_prop in H0.
        apply c_wins_true. apply wins_prop_iterated_marg. auto.
      Qed.

      (* aligning of c_wins with losing condition *)
      Lemma c_wins_false_type:
        forall c : cand, c_wins c = false <-> (exists x : loses_type c, wins_loses_type_dec c = inr x).
      Proof.
        split; intros. destruct (wins_loses_type_dec c) eqn:Ht.
        pose proof (wins_type_prop c w).
        pose proof (proj1 (c_wins_false c) H). unfold wins_prop in H0.
        pose proof (wins_prop_iterated_marg c H0). destruct H1. specialize (H2 x). lia.
        exists l. auto.
        destruct H. pose proof (loses_type_prop c x). unfold loses_prop in H0.
        apply c_wins_false. apply loses_prop_iterated_marg. auto.
      Qed.
  End Marg.
End Margin.


Require Import List.
Require Import String.
Require Import ZArith.

Ltac break_if :=
  match goal with
    | _ : context [ if ?cond then _ else _ ] |- _ =>
     destruct cond as [] eqn:?
    | |- context [ if ?cond then _ else _ ] =>
      destruct cond as [] eqn:?
    | _ : context [ match ?cond with _ => _ end ] |- _ =>
     destruct cond as [] eqn:?
    | |- context [ match ?cond with _ => _ end ] =>
      destruct cond as [] eqn:?
  end.

(*
  We will extend IMP with the ability to push and pop heaps.

  In normal IMP, program states just included the heap "h" and
  statement to execute "s".

  In our extended version of IMP, program state will also include
  the current stack of heaps "l", represented as a list.

  There will be two new statements: "PushHeap" and "PopHeap x".
    - "PushHeap" adds the current heap "h" to the beginning of "l".
      Informally, it copies "h" all at once.
    - "PopHeap x" replaces the current heap "h" with the first
      element of "l" *except* "x" maps to "lkup x h" and replaces "l"
      with the tail of "l".  If "l" is the empty list, then
     "PopHeap x" has no effect.
  Both "PushHeap" and "PopHeap x" become Skip in one step.
*)

Set Implicit Arguments.

Definition var := string.

(* We'll start by defining the syntax of our extended IMP. *)

(* Expressions are just like those from IMP seen in lecture. *)
Inductive Expr : Type :=
| Int : Z -> Expr
| Var : var -> Expr
| Add : Expr -> Expr -> Expr
| Mul : Expr -> Expr -> Expr.

(* Add the PushHeap and PopHeap x statements to the Stmt type. *)
Inductive Stmt : Type :=
| Skip : Stmt
| Assign : var -> Expr -> Stmt
| Seq : Stmt -> Stmt -> Stmt
| Cond : Expr -> Stmt -> Stmt -> Stmt
| While : Expr -> Stmt -> Stmt
(*
  [PROBLEM 1]
  Add constructors for PushHeap and PopHeap x here.
*)
.

(* Next we define the semantics of our language *)

(* Heaps are represented as association lists. *)
Definition Heap := list (var * Z).

Fixpoint lkup (x: var) (h: Heap) :=
  match h with
    | nil => 0%Z
    | (k, v) :: h' => if string_dec x k then v else lkup x h'
  end.

(* Since expressions are unchanged from IMP, their semantics are the same: *)
Inductive Eval : Heap -> Expr -> Z -> Prop :=
| EInt : forall h z,
  Eval h (Int z) z
| EVar : forall h v,
  Eval h (Var v) (lkup v h)
| EAdd : forall h e1 e2 c1 c2 c3,
  Eval h e1 c1 ->
  Eval h e2 c2 ->
  c3 = (c1 + c2)%Z ->
  Eval h (Add e1 e2) c3
| EMul : forall h e1 e2 c1 c2 c3,
  Eval h e1 c1 ->
  Eval h e2 c2 ->
  c3 = (c1 * c2)%Z ->
  Eval h (Mul e1 e2) c3.

(*
  Define a small-step operational semantics for our extended version of IMP.
  Because the form of rules has changed, include all the rules.
*)
Inductive Step : list Heap -> Heap -> Stmt ->
                 list Heap -> Heap -> Stmt -> Prop :=
(*
  [PROBLEM 2]
  Add the rules (constructors) for the small step semantics of
  our extended version of IMP.  I have 10 rules in my solution.

  * NOTE *
  For statements that involve branching (Cond and While), the
  "then" / "enter loop" branch should be taken when the condition
  expression evaluates to something not equal to 0, and the
  "else" / "exit loop" branch should be taken when the condition
  expression evaluates to 0.
*)
.

(*
  [PROBLEM 3]
  In a short English paragraph, explain why our language would be much less
  useful if popping a heap did not copy one value from the popped heap.
*)

(*
  [PROBLEM 4]
  Give an interesting IMP program that uses both "PushHeap" and "PopHeap x".
*)

(* Interpreters *)

(*
  In class we saw how to implement and verify a function
  that evaluates expressions:
*)

Fixpoint eval (h: Heap) (e: Expr) : Z :=
  match e with
    | Int z => z
    | Var v => lkup v h
    | Add e1 e2 => Z.add (eval h e1) (eval h e2)
    | Mul e1 e2 => Z.mul (eval h e1) (eval h e2)
  end.

Lemma eval_Eval:
  forall h e c,
  eval h e = c -> Eval h e c.
Proof.
  intro. intro. induction e.
  { intros. simpl in *. subst. constructor. }
  { intros. simpl in *. rewrite <- H. constructor. }
  { intros. simpl in *. econstructor.
    { firstorder. }
    { firstorder. }
    { firstorder. }
  }
  { intros. simpl in *. econstructor.
    { firstorder. }
    { firstorder. }
    { firstorder. }
  }
Qed.

Lemma Eval_eval:
  forall h e c,
  Eval h e c -> eval h e = c.
Proof.
  intros. induction H.
  { reflexivity. }
  { reflexivity. }
  { subst. reflexivity. }
  { subst. reflexivity. }
Qed.

Lemma Eval_eval':
  forall h e,
  Eval h e (eval h e).
Proof.
  intros. remember (eval h e) as c. apply eval_Eval. omega.
Qed.

(* [Problem 5] *)
(* Write a function which tests whether a statement is a Skip statement. *)
Definition isSkip (s: Stmt) : bool :=
 (* TODO *)
 false.

(* [Problem 6] *)
(* Prove isSkip correct in the true case. *)
Lemma isSkip_t:
  forall s, isSkip s = true -> s = Skip.
Proof.
  (* TODO *)
  admit.
Qed.

(* [Problem 7] *)
(* Prove isSkip correct in the false case. *)
Lemma isSkip_f:
  forall s, isSkip s = false -> s <> Skip.
Proof.
  (* TODO *)
  admit.
Qed.

(* [Problem 8] *)
(* Implement step as a function. *)
(* Hint: Use your isSkip function in the Seq case. *)
(* Hint: Z.eq_dec decides if a Z is equal to 0. *)
Check Z.eq_dec.
Fixpoint step (l: list Heap) (h: Heap) (s: Stmt) :
  option (list Heap * Heap * Stmt) :=
  (* TODO *)
  None.

(* [Problem 9] *)
(* Prove that only Skip cannot step. *)
Lemma step_None_Skip:
  forall l h s, step l h s = None -> s = Skip.
Proof.
  (* TODO *)
  admit.
Qed.

(* [Problem 10] *)
(* Prove that your step function is SOUND with respect to the Step relation. *)
Lemma step_Step:
  forall l h s l' h' s',
  step l h s = Some (l', h', s') -> Step l h s l' h' s'.
Proof.
  (* TODO *)
  admit.
Qed.

(* [Problem 11] *)
(* Prove that your step function is COMPLETE with respect to the Step relation. *)
Lemma Step_step:
  forall l h s l' h' s',
  Step l h s l' h' s' -> step l h s = Some (l', h', s').
Proof.
  (* TODO *)
  admit.
Qed.

(* StepN as seen in class *)
Inductive StepN : list Heap -> Heap -> Stmt -> nat ->
                  list Heap -> Heap -> Stmt -> Prop :=
| StepN_refl : forall l h s,
  StepN l h s 0 l h s
| StepN_step : forall l h s l' h' s' l'' h'' s'' n,
  Step l h s l' h' s' ->
  StepN l' h' s' n l'' h'' s'' ->
  StepN l h s (S n) l'' h'' s''.

(* [Problem 12] *)
(* Implement stepn as a function. *)
Fixpoint stepn (l: list Heap) (h: Heap) (s: Stmt) (n: nat) :
  option (list Heap * Heap * Stmt) :=
  (* TODO *)
  None.

(* [Problem 13] *)
(* Prove your stepn function SOUND. *)
Lemma stepn_StepN:
  forall n l h s l' h' s',
  stepn l h s n = Some (l', h', s') ->
  StepN l h s n l' h' s'.
Proof.
  (* TODO *)
  admit.
Qed.

(* [Problem 14] *)
(* Prove your stepn function COMPLETE. *)
Lemma StepN_stepn:
  forall l h s n l' h' s',
  StepN l h s n l' h' s' ->
  stepn l h s n = Some (l', h', s').
Proof.
  (* TODO *)
  admit.
Qed.

(* The run function, which takes up to n steps. *)
Fixpoint run (n: nat) (l: list Heap) (h: Heap) (s: Stmt) : list Heap * Heap * Stmt :=
  match n with
    | O => (l, h, s)
    | S m =>
      match step l h s with
        | Some (l', h', s') => run m l' h' s'
        | None => (l, h, s)
      end
  end.

(* [Problem 15] *)
(* Define the StepStar relation, which corresponds to taking any number of steps. *)
Inductive StepStar : list Heap -> Heap -> Stmt ->
                     list Heap -> Heap -> Stmt -> Prop :=
  (* TODO *)
.

(* [Problem 16] *)
(* Prove that run is SOUND with respect to StepStar. *)
Lemma run_StepStar:
  forall n l h s l' h' s',
  run n l h s = (l', h', s') -> StepStar l h s l' h' s'.
Proof.
  (* TODO *)
  admit.
Qed.

(* [Problem 17] *)
(* Prove that running a state that can't step gives that same state. *)
Lemma nostep_run_refl:
  forall l h s, step l h s = None ->
  forall n, run n l h s = (l, h, s).
Proof.
  (* TODO *)
  admit.
Qed.

(* [Problem 18] *)
(* Prove that two consecutive runs are the same as one bigger run. *)
Lemma run_combine:
  forall m n l h s l' h' s' l'' h'' s'',
  run m l h s = (l', h', s') ->
  run n l' h' s' = (l'', h'', s'') ->
  run (m + n) l h s = (l'', h'', s'').
Proof.
  (* TODO *)
  admit.
Qed.

(* Here we define what it means for a statement to contain a while. *)
Fixpoint hasWhile (s: Stmt) : bool :=
  match s with
    | Skip => false
    | Assign _ _ => false
    | Seq s1 s2 => orb (hasWhile s1) (hasWhile s2)
    | Cond _ s1 s2 =>  orb (hasWhile s1) (hasWhile s2)
    | While _ _ => true
    | PushHeap => false
    | PopHeap _ => false
  end.

(* Here we define the number of PushHeap statements contained in a statement. *)
Fixpoint nPushHeap (s: Stmt) : nat :=
  match s with
    | Skip => 0
    | Assign _ _ => 0
    | Seq s1 s2 => nPushHeap s1 + nPushHeap s2
    | Cond _ s1 s2 => nPushHeap s1 + nPushHeap s2
    | While _ s1 => nPushHeap s1
    | PushHeap => 1
    | PopHeap _ => 0
  end.

(*
  [Problem 19]
  Prove that if we take a step from a statement without any whiles,
  then the resulting statement still has no whiles.
*)
Lemma hasWhileStep:
  forall l h s l' h' s',
    Step l h s l' h' s' ->
    hasWhile s = false ->
    hasWhile s' = false.
Proof.
  (* TODO *)
  admit.
Qed.

(* *** A BIT TRICKY! *** *)
(*
  [Problem 20]

  State and prove the following property:
    If statement s has no While loops and from the empty stack
    (l = nil) and empty heap (h = nil), s can step to stack l',
    heap h', and statement s', then the length of l' does not
    exceed the number of PushHeap statements in s (the original
    statement).

  Hints:
    - You will need two lemmas to prove this.
    - Think carefully about your induction hypotheses.
*)

(*
  [Problem 21]

  Prove the previous claim is false if we allow s to contain
  While loops.

  Hint:
    - No need to use induction.
*)

(* Define a weak notion of equivalence between programs. *)
Definition equiv (s1 s2: Stmt) :=
  forall l1' h1' l2' h2',
  StepStar nil nil s1 l1' h1' Skip ->
  StepStar nil nil s2 l2' h2' Skip ->
  l1' = l2' /\ h1' = h2'.

(*
  [Problem 22]
  Prove the following equivalence.
*)
Lemma progs_equiv:
  ~ (forall s x,
  equiv (Seq s (Assign x (Int 0%Z))
        (Seq PushHeap (Seq s (PopHeap x)))).
Proof.
  (* TODO *)
  admit.
Qed.


(** * Rel: Properties of Relations *)

(* $Date: 2014-08-24 04:24:59 +0900 (2014年08月24日 (日)) $ *)

Require Export SfLib.

(** A (binary) _relation_ is just a parameterized proposition. As you know
    from your undergraduate discrete math course, there are a lot of
    ways of discussing and describing relations _in general_ -- ways
    of classifying relations (are they reflexive, transitive, etc.),
    theorems that can be proved generically about classes of
    relations, constructions that build one relation from another,
    etc.  Let us pause here to review a few that will be useful in
    what follows. *)

(** A (binary) relation _on_ a set [X] is a proposition parameterized by two
    [X]s -- i.e., it is a logical assertion involving two values from
    the set [X].  *)

Definition relation (X: Type) := X->X->Prop.

(** Somewhat confusingly, the Coq standard library hijacks the generic
    term "relation" for this specific instance. To maintain
    consistency with the library, we will do the same.  So, henceforth
    the Coq identifier [relation] will always refer to a binary
    relation between some set and itself, while the English word
    "relation" can refer either to the specific Coq concept or the
    more general concept of a relation between any number of possibly
    different sets.  The context of the discussion should always make
    clear which is meant. *)

(** An example relation on [nat] is [le], the less-that-or-equal-to
    relation which we usually write like this [n1 <= n2]. *)

Print le.
(* ====>
Inductive le (n : nat) : nat -> Prop :=
    le_n : n <= n
  | le_S : forall m : nat, n <= m -> n <= S m
*)
Check le : nat -> nat -> Prop.
Check le : relation nat.

(* ######################################################### *)
(** * Basic Properties of Relations *)

(** A relation [R] on a set [X] is a _partial function_ if, for every
    [x], there is at most one [y] such that [R x y] -- i.e., if [R x
    y1] and [R x y2] together imply [y1 = y2]. *)

Definition partial_function {X: Type} (R: relation X) :=
  forall x y1 y2 : X, R x y1 -> R x y2 -> y1 = y2.

(** For example, the [next_nat] relation defined in Logic.v is a
    partial function. *)

(* Print next_nat.
(* ====>
Inductive next_nat (n : nat) : nat -> Prop :=
  nn : next_nat n (S n)
*)
Check next_nat : relation nat.

Theorem next_nat_partial_function :
   partial_function next_nat.
Proof.
  unfold partial_function.
  intros x y1 y2 H1 H2.
  inversion H1. inversion H2.
  reflexivity.  Qed. *)

(** However, the [<=] relation on numbers is not a partial function.

    This can be shown by contradiction.  In short: Assume, for a
    contradiction, that [<=] is a partial function.  But then, since
    [0 <= 0] and [0 <= 1], it follows that [0 = 1].  This is nonsense,
    so our assumption was contradictory. *)

Theorem le_not_a_partial_function :
  ~ (partial_function le).
Proof.
  unfold not. unfold partial_function. intros Hc.
  assert (0 = 1) as Nonsense.
   Case "Proof of assertion".
   apply Hc with (x := 0).
     apply le_n.
     apply le_S. apply le_n.
  inversion Nonsense.   Qed.

(** **** Exercise: 2 stars, optional  *)
(** Show that the [total_relation] defined in Logic.v is not a partial
    function. *)

(* FILL IN HERE *)
(** [] *)

(** **** Exercise: 2 stars, optional  *)
(** Show that the [empty_relation] defined in Logic.v is a partial
    function. *)

(* FILL IN HERE *)
(** [] *)

(** A _reflexive_ relation on a set [X] is one for which every element
    of [X] is related to itself. *)

Definition reflexive {X: Type} (R: relation X) :=
  forall a : X, R a a.

Theorem le_reflexive :
  reflexive le.
Proof.
  unfold reflexive. intros n. apply le_n.  Qed.

(** A relation [R] is _transitive_ if [R a c] holds whenever [R a b]
    and [R b c] do. *)

Definition transitive {X: Type} (R: relation X) :=
  forall a b c : X, (R a b) -> (R b c) -> (R a c).

Theorem le_trans :
  transitive le.
Proof.
  intros n m o Hnm Hmo.
  induction Hmo.
  Case "le_n". apply Hnm.
  Case "le_S". apply le_S. apply IHHmo.  Qed.

Theorem lt_trans:
  transitive lt.
Proof.
  unfold lt. unfold transitive.
  intros n m o Hnm Hmo.
  apply le_S in Hnm.
  apply le_trans with (a := (S n)) (b := (S m)) (c := o).
  apply Hnm.
  apply Hmo. Qed.

(** **** Exercise: 2 stars, optional  *)
(** We can also prove [lt_trans] more laboriously by induction,
    without using le_trans.  Do this.*)

Theorem lt_trans' :
  transitive lt.
Proof.
  (* Prove this by induction on evidence that [m] is less than [o]. *)
  unfold lt. unfold transitive.
  intros n m o Hnm Hmo.
  induction Hmo as [| m' Hm'o].
    (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars, optional  *)
(** Prove the same thing again by induction on [o]. *)

Theorem lt_trans'' :
  transitive lt.
Proof.
  unfold lt. unfold transitive.
  intros n m o Hnm Hmo.
  induction o as [| o'].
  (* FILL IN HERE *) Admitted.
(** [] *)

(** The transitivity of [le], in turn, can be used to prove some facts
    that will be useful later (e.g., for the proof of antisymmetry
    below)... *)

Theorem le_Sn_le : forall n m, S n <= m -> n <= m.
Proof.
  intros n m H. apply le_trans with (S n).
    apply le_S. apply le_n.
    apply H.  Qed.

(** **** Exercise: 1 star, optional  *)
Theorem le_S_n : forall n m,
  (S n <= S m) -> (n <= m).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars, optional (le_Sn_n_inf)  *)
(** Provide an informal proof of the following theorem:

    Theorem: For every [n], [~(S n <= n)]

    A formal proof of this is an optional exercise below, but try
    the informal proof without doing the formal proof first.

    Proof:
    (* FILL IN HERE *)
    []
 *)

(** **** Exercise: 1 star, optional  *)
Theorem le_Sn_n : forall n,
  ~ (S n <= n).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** Reflexivity and transitivity are the main concepts we'll need for
    later chapters, but, for a bit of additional practice working with
    relations in Coq, here are a few more common ones.

   A relation [R] is _symmetric_ if [R a b] implies [R b a]. *)

Definition symmetric {X: Type} (R: relation X) :=
  forall a b : X, (R a b) -> (R b a).

(** **** Exercise: 2 stars, optional  *)
Theorem le_not_symmetric :
  ~ (symmetric le).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** A relation [R] is _antisymmetric_ if [R a b] and [R b a] together
    imply [a = b] -- that is, if the only "cycles" in [R] are trivial
    ones. *)

Definition antisymmetric {X: Type} (R: relation X) :=
  forall a b : X, (R a b) -> (R b a) -> a = b.

(** **** Exercise: 2 stars, optional  *)
Theorem le_antisymmetric :
  antisymmetric le.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars, optional  *)
Theorem le_step : forall n m p,
  n < m ->
  m <= S p ->
  n <= p.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** A relation is an _equivalence_ if it's reflexive, symmetric, and
    transitive.  *)

Definition equivalence {X:Type} (R: relation X) :=
  (reflexive R) /\ (symmetric R) /\ (transitive R).

(** A relation is a _partial order_ when it's reflexive,
    _anti_-symmetric, and transitive.  In the Coq standard library
    it's called just "order" for short. *)

Definition order {X:Type} (R: relation X) :=
  (reflexive R) /\ (antisymmetric R) /\ (transitive R).

(** A preorder is almost like a partial order, but doesn't have to be
    antisymmetric. *)

Definition preorder {X:Type} (R: relation X) :=
  (reflexive R) /\ (transitive R).

Theorem le_order :
  order le.
Proof.
  unfold order. split.
    Case "refl". apply le_reflexive.
    split.
      Case "antisym". apply le_antisymmetric.
      Case "transitive.". apply le_trans.  Qed.

(* ########################################################### *)
(** * Reflexive, Transitive Closure *)

(** The _reflexive, transitive closure_ of a relation [R] is the
    smallest relation that contains [R] and that is both reflexive and
    transitive.  Formally, it is defined like this in the Relations
    module of the Coq standard library: *)

Inductive clos_refl_trans {A: Type} (R: relation A) : relation A :=
    | rt_step : forall x y, R x y -> clos_refl_trans R x y
    | rt_refl : forall x, clos_refl_trans R x x
    | rt_trans : forall x y z,
          clos_refl_trans R x y ->
          clos_refl_trans R y z ->
          clos_refl_trans R x z.

(** For example, the reflexive and transitive closure of the
    [next_nat] relation coincides with the [le] relation. *)

Theorem next_nat_closure_is_le : forall n m,
  (n <= m) <-> ((clos_refl_trans next_nat) n m).
Proof.
  intros n m. split.
    Case "->".
      intro H. induction H.
      SCase "le_n". apply rt_refl.
      SCase "le_S".
        apply rt_trans with m. apply IHle. apply rt_step. apply nn.
    Case "<-".
      intro H. induction H.
      SCase "rt_step". inversion H. apply le_S. apply le_n.
      SCase "rt_refl". apply le_n.
      SCase "rt_trans".
        apply le_trans with y.
        apply IHclos_refl_trans1.
        apply IHclos_refl_trans2. Qed.

(** The above definition of reflexive, transitive closure is
    natural -- it says, explicitly, that the reflexive and transitive
    closure of [R] is the least relation that includes [R] and that is
    closed under rules of reflexivity and transitivity.  But it turns
    out that this definition is not very convenient for doing
    proofs -- the "nondeterminism" of the [rt_trans] rule can sometimes
    lead to tricky inductions.

    Here is a more useful definition... *)

Inductive refl_step_closure {X:Type} (R: relation X) : relation X :=
  | rsc_refl  : forall (x : X), refl_step_closure R x x
  | rsc_step : forall (x y z : X),
                    R x y ->
                    refl_step_closure R y z ->
                    refl_step_closure R x z.

(** (Note that, aside from the naming of the constructors, this
    definition is the same as the [multi] step relation used in many
    other chapters.) *)

(** (The following [Tactic Notation] definitions are explained in
    Imp.v.  You can ignore them if you haven't read that chapter
    yet.) *)

Tactic Notation "rt_cases" tactic(first) ident(c) :=
  first;
  [ Case_aux c "rt_step" | Case_aux c "rt_refl"
  | Case_aux c "rt_trans" ].

Tactic Notation "rsc_cases" tactic(first) ident(c) :=
  first;
  [ Case_aux c "rsc_refl" | Case_aux c "rsc_step" ].

(** Our new definition of reflexive, transitive closure "bundles"
    the [rt_step] and [rt_trans] rules into the single rule step.
    The left-hand premise of this step is a single use of [R],
    leading to a much simpler induction principle.

    Before we go on, we should check that the two definitions do
    indeed define the same relation...

    First, we prove two lemmas showing that [refl_step_closure] mimics
    the behavior of the two "missing" [clos_refl_trans]
    constructors.  *)

Theorem rsc_R : forall (X:Type) (R:relation X) (x y : X),
       R x y -> refl_step_closure R x y.
Proof.
  intros X R x y H.
  apply rsc_step with y. apply H. apply rsc_refl.   Qed.

(** **** Exercise: 2 stars, optional (rsc_trans)  *)
Theorem rsc_trans :
  forall (X:Type) (R: relation X) (x y z : X),
      refl_step_closure R x y  ->
      refl_step_closure R y z ->
      refl_step_closure R x z.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** Then we use these facts to prove that the two definitions of
    reflexive, transitive closure do indeed define the same
    relation. *)

(** **** Exercise: 3 stars, optional (rtc_rsc_coincide)  *)
Theorem rtc_rsc_coincide :
         forall (X:Type) (R: relation X) (x y : X),
  clos_refl_trans R x y <-> refl_step_closure R x y.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)


From Undecidability.Shared.Libs.PSL Require Import FinTypes.
From Complexity.NP.Clique Require Import UGraph.
Require Import Lia.

Section fixGraph.
  Variable (g : UGraph).
  Notation V := (V g).
  Notation E := (@E g).

  Definition isClique (l : list V) := (forall v1 v2, v1 el l -> v2 el l -> v1 <> v2 -> E (v1, v2)) /\ dupfree l.
  Definition isKClique k (l : list V) := |l| = k /\ isClique l.

  (** an alternative inductive characterisation *)
  Inductive indKClique : nat -> list V -> Prop :=
    | indKCliqueNil : indKClique 0 []
    | indKCliqueS L v k : indKClique k L -> not (v el L) -> (forall v', v' el L -> E (v, v')) -> indKClique (S k) (v :: L).
  Hint Constructors indKClique : core.

  Lemma indKClique_iff k L: isKClique k L <-> indKClique k L.
  Proof.
    split.
    - intros [H1 [H2 H3]]. revert L H1 H2 H3. induction k; intros.
      + destruct L; cbn in H1; [ eauto | congruence].
      + destruct L; cbn in *; [congruence | ].
        constructor.
        * apply IHk; [lia | intros; apply H2; eauto | now inv H3].
        * now inv H3.
        * intros v' Hel. apply H2; [eauto | eauto | ]. inv H3. intros ->. congruence.
    - induction 1 as [ | ? ? ? ? IH].
      + split; [ | split]; [now cbn | intros ? ? [] | constructor].
      + destruct IH as (IH1 & IH2 & IH3). split; [ | split].
        * cbn. lia.
        * intros v1 v2 [-> | H2] [-> | H3] H4; try congruence.
          -- now apply H1.
          -- apply E_symm. now apply H1.
          -- now apply IH2.
        * now constructor.
  Qed.
End fixGraph.

Definition Clique (i : UGraph * nat) := let (g, k) := i in exists l, @isKClique g k l.