(** Transition Matrices with arbitrary values **)
Require Import Reals.
Require Import Coq.FSets.FMapWeakList.
Require Import Coq.FSets.FMapFacts.
Require Import Coq.Lists.SetoidList.

Open Scope R_scope.

Require Import ListUtils.
Require Import State.

Module StateMaps := FMapWeakList.Make DecidableState.
Module StateMapsFacts := WFacts_fun DecidableState StateMaps.
Module StateMapsProperties := WProperties_fun DecidableState StateMaps.

Definition TransitionMatrix (t: Type) := StateMaps.t (StateMaps.t t).

Definition sum_f {S T: Type} (l: list (prod S T)) (f: T -> T -> T) (t0: T) : T :=
    fold_right (fun ( e: prod S T ) (t: T) => f t (snd e) ) t0 l.

Definition sum_f_in_map {T: Type} (m: StateMaps.t T) (f: T -> T -> T) (t0: T) : T :=
    sum_f (StateMaps.elements m) f t0.

Definition sum_in_map (m: StateMaps.t R) : R := sum_f_in_map m Rplus 0.

(** ** Correspondence between In and MapsTo **)

Lemma in_mapsto {T: Type}:
    forall (r: StateMaps.t T) (s: State),
        StateMaps.In s r <-> exists v: T, StateMaps.MapsTo s v r.
Proof.
    intros. split.
    - auto.
    - auto.
Qed.

Lemma mapsto_in {T: Type}:
    forall (r: StateMaps.t T) (s: State),
        forall v: T, StateMaps.MapsTo s v r -> StateMaps.In s r.
Proof.
    intros. rewrite in_mapsto. exists v. apply H.
Qed.

(** Useful lemmas about lists of elements **)

Lemma remove_nodup (T: Type):
    forall (l: list (State * T))
           (s: State)
           (t: T),
         ~InA (StateMaps.Raw.PX.eqk (elt:=T)) (s, t) l ->
         StateMaps.Raw.remove s l = l.
Proof.
    intros.
    induction l.
    - auto.
    - (* make IH applicable *)
      intuition.
      destruct a as [s' t'].
      unfold StateMaps.Raw.remove.
      destruct (StateMapsProperties.F.eq_dec s s') as [H' | H'].
      + (* s = s' *)
        rewrite <- H' in H.
        assert (H_eq: (StateMaps.Raw.PX.eqk (elt:=T)) (s, t) (s, t')).
        {
          - auto.
        }
        apply InA_cons_hd with (l:=l) in H_eq.
        apply H in H_eq. contradiction.
      + (* s <> s' *)
        unfold StateMaps.Raw.remove in H0.
        rewrite H0. trivial.
Qed.

Lemma remove_distributive (T: Type):
    forall (l1 l2: list (State * T))
           (s: State),
         SetoidList.NoDupA (StateMaps.Raw.PX.eqk (elt:=T)) (l1 ++ l2) ->
         StateMaps.Raw.remove s (l1 ++ l2) = (StateMaps.Raw.remove s l1) ++ (StateMaps.Raw.remove s l2).
Proof.
    intros.
    induction l1.
    - rewrite ?app_nil_l. trivial.
    - rewrite <- app_comm_cons.
      destruct a as [s' t].
      destruct (StateMapsProperties.F.eq_dec s s') as [H' | H'].
      + rewrite <- H'.
        rewrite <- H' in H.
        rewrite <- app_comm_cons in H.
        inversion H as [H_nil | x l H_x_not_in_l H_nodup_l].
        apply IHl1 in H_nodup_l.
        simpl.
        destruct (StateMapsProperties.F.eq_dec s s) as [H'' | H''].
        * apply not_InA in H_x_not_in_l.
          destruct H_x_not_in_l as [H_x_not_in_l1 H_x_not_in_l2].
          rewrite remove_nodup with (t:=t).
          trivial. assumption.
        * contradiction.
      + unfold StateMaps.Raw.remove at 1.
        destruct (StateMapsProperties.F.eq_dec s s') as [H'' | _].
        * rewrite H'' in H'. contradiction.
        * inversion H as [H_nil | x l H_x_not_in_l H_nodup_l].
          apply IHl1 in H_nodup_l.
          unfold StateMaps.Raw.remove at 1 in H_nodup_l.
          rewrite H_nodup_l.
          {
            unfold StateMaps.Raw.remove at 3.
            destruct (StateMapsProperties.F.eq_dec s s') as [H'' | _].
            - rewrite H'' in H'. contradiction.
            - replace
                ((fix
                 remove (k : StateMaps.Raw.key) (s0 : StateMaps.Raw.t T) {struct s0} :
                   StateMaps.Raw.t T :=
                   match s0 with
                   | Datatypes.nil => Datatypes.nil
                   | (k', x0) :: l0 =>
                       if StateMapsProperties.F.eq_dec k k'
                       then l0
                       else (k', x0) :: remove k l0
                   end) s l1)
              with (StateMaps.Raw.remove (elt:=T) s l1).
              trivial.
              unfold StateMaps.Raw.remove. trivial.
          }
Qed.

Lemma remove_middle (T: Type):
    forall (l1 l2: list (State * T))
           (s: State)
           (t: T),
        (~ SetoidList.InA (StateMaps.Raw.PX.eqk (elt:=T)) (s, t) (l1 ++ l2)) ->
        (NoDupA (StateMaps.Raw.PX.eqk (elt:=T)) (l1 ++ l2)) ->
            StateMaps.Raw.remove s (l1 ++ (s, t)::l2) = l1++l2.
Proof.
    intros l1 l2 s t H H_nodup.
    induction l1; induction l2; try rewrite ?app_nil_l.
    - (* l1 = nil /\ l2 = nil *)
      unfold StateMaps.Raw.remove.
      destruct (StateMapsProperties.F.eq_dec s s).
      trivial. contradiction.
    - (* l1 = nil /\ l2 = a :: l *)
      unfold StateMaps.Raw.remove.
      destruct (StateMapsProperties.F.eq_dec s s).
      trivial. contradiction.
    - (* l1 = a::l /\ l2 = nil *)
      rewrite ?app_nil_r in H. rewrite ?app_nil_r in IHl1.
      intuition.
      rewrite <- app_comm_cons.
      unfold StateMaps.Raw.remove.
      unfold StateMaps.Raw.remove in H0.
      rewrite H0.
        Focus 2.
          rewrite app_nil_r in H_nodup.
          inversion H_nodup. assumption.
      destruct a. simpl.
      destruct (StateMapsProperties.F.eq_dec s s0).
      + (* s = s0 *)
        contradict e.
        rewrite SetoidList.InA_cons in H.
        contradict H. rewrite H.
        left. auto.
      + (* s <> s0 *)
        symmetry. apply app_nil_r with (l:=(s0, t0)::l1).
    - (* l1 = a::l /\ l2 = a0::l' *)
      rewrite remove_distributive.
      + apply not_InA in H.
        destruct H as [H_s_not_in_al1 H_s_not_in_a0l2].
        apply remove_nodup in H_s_not_in_al1. rewrite H_s_not_in_al1.
        replace (StateMaps.Raw.remove (elt:=T) s ((s, t) :: a0 :: l2))
          with (a0 :: l2).
        trivial.
        symmetry. simpl.
        destruct (StateMapsProperties.F.eq_dec s s) as [H|H].
        * trivial.
        * contradiction.
      + specialize (NoDupA_cons H H_nodup). intros H_nodup_s.
        apply NoDupA_swap'.
        * exact (StateMapsProperties.eqk_equiv T).
        * assumption.
Qed.

Lemma remove_elements' (T: Type):
    forall (r: StateMaps.t T)
           (s: State)
           (e: T)
           (l1 l2: list (State * T))
           (a: State * T),
        StateMaps.eq_key_elt (s, e) a ->
        StateMaps.elements r = l1 ++ a::l2 ->
            StateMaps.elements (StateMaps.remove s r) = l1++l2.
Proof.
    intros r s e l1 l2 a H_eq_pair H_elem.
    unfold StateMaps.elements, StateMaps.Raw.elements in H_elem.
    simpl. rewrite H_elem.
  (* s, e = fst a, snd a *)
    destruct H_eq_pair as [H_s H_e].
    simpl in H_s. simpl in H_e.
  (* *)
    destruct l1(* ; destruct l2 *).
    - destruct a. rewrite H_s.
      rewrite app_nil_l. rewrite app_nil_l.
      simpl. compute.
      destruct (State.eq_dec s0 s0).
      + reflexivity.
      + contradiction.
    - destruct a. rewrite H_s.
    (* we need to generate a hypothesis stating that p <> a *)
      destruct r. simpl in H_elem.
      rewrite H_elem in NoDup.
      destruct p. simpl.
      destruct (StateMapsProperties.F.eq_dec s0 s1).
      + (* s0 = s1 *)
        contradict e0.
        inversion NoDup as [H | x l H_x_not_in_l H_nodup_l].
        contradict H_x_not_in_l.
        rewrite H_x_not_in_l.
        rewrite SetoidList.InA_app_iff.
        right. auto.
      + (* s0 <> s1 *)
        replace (StateMaps.Raw.remove (elt:=T) s0 (l1 ++ (s0, t) :: l2))
          with (l1 ++ l2).
        auto.
        symmetry. apply remove_middle.
        inversion NoDup as [H | x l H_x_not_in_l H_nodup_l].
        apply SetoidList.NoDupA_swap in H_nodup_l.
        inversion H_nodup_l.
        * assumption.
        * exact (StateMapsProperties.eqk_equiv T).
        * rewrite app_comm_cons in NoDup.
          apply NoDupA_swap' in NoDup.
          apply NoDupA_split in NoDup.
          apply NoDupA_split in NoDup.
          assumption.
          exact (StateMapsProperties.eqk_equiv T).
Qed.


Require Import Crypto.Arithmetic.PrimeFieldTheorems.
Require Import Crypto.Specific.solinas32_2e230m27_10limbs.Synthesis.

(* TODO : change this to field once field isomorphism happens *)
Definition mul :
  { mul : feBW_loose -> feBW_loose -> feBW_tight
  | forall a b, phiBW_tight (mul a b) = F.mul (phiBW_loose a) (phiBW_loose b) }.
Proof.
  Set Ltac Profiling.
  Time synthesize_mul ().
  Show Ltac Profile.
Time Defined.

Print Assumptions mul.


Require Import Crypto.Arithmetic.PrimeFieldTheorems.
Require Import Crypto.Specific.solinas64_2e488m17_10limbs.Synthesis.

(* TODO : change this to field once field isomorphism happens *)
Definition mul :
  { mul : feBW_loose -> feBW_loose -> feBW_tight
  | forall a b, phiBW_tight (mul a b) = F.mul (phiBW_loose a) (phiBW_loose b) }.
Proof.
  Set Ltac Profiling.
  Time synthesize_mul ().
  Show Ltac Profile.
Time Defined.

Print Assumptions mul.


From Test Require Import tactic.

Section FOFProblem.

Variable Universe : Set.
Variable UniverseElement : Universe.

Variable wd_ : Universe -> Universe -> Prop.
Variable col_ : Universe -> Universe -> Universe -> Prop.

Variable col_swap1_1 : (forall A B C : Universe, (col_ A B C -> col_ B A C)).
Variable col_swap2_2 : (forall A B C : Universe, (col_ A B C -> col_ B C A)).
Variable col_triv_3 : (forall A B : Universe, col_ A B B).
Variable wd_swap_4 : (forall A B : Universe, (wd_ A B -> wd_ B A)).
Variable col_trans_5 : (forall P Q A B C : Universe, ((wd_ P Q /\ (col_ P Q A /\ (col_ P Q B /\ col_ P Q C))) -> col_ A B C)).

Theorem pipo_6 : (forall A B C Cprime : Universe, ((wd_ B A /\ (wd_ B Cprime /\ (wd_ A Cprime /\ (wd_ B C /\ (col_ A B C /\ col_ A B Cprime))))) -> col_ B Cprime C)).
Proof.
  time tac.
Qed.

End FOFProblem.


Require Import Crypto.Arithmetic.PrimeFieldTheorems.
Require Import Crypto.Specific.solinas32_2e255m765_13limbs.Synthesis.

(* TODO : change this to field once field isomorphism happens *)
Definition mul :
  { mul : feBW_loose -> feBW_loose -> feBW_tight
  | forall a b, phiBW_tight (mul a b) = F.mul (phiBW_loose a) (phiBW_loose b) }.
Proof.
  Set Ltac Profiling.
  Time synthesize_mul ().
  Show Ltac Profile.
Time Defined.

Print Assumptions mul.


From Coq Require Import Lists.List.
From Coq Require Import Bool.Bool.
From Coq Require Import Lia.
From Coq Require Import FSets.FMapList.
From Coq Require Import FSets.FMapFacts.
From Coq Require Import Init.Nat.
From Coq Require Import Structures.OrderedTypeEx.
Require Import RuntimeDefinitions.
Require Import AppendixD.
Require Import AppendixC.
Require Import AppendixF.
Require Import AppendixE.
Require Import Semantics.
Require Import MLCOperations.
Require Import WellFormed.

Module NatMapFacts := NatMapProperties.F.
Module CacheletMapFacts := CacheletMapProperties.F.

(* Well-Formed 6 *)
Definition wf6 (sigma: runtime_state): Prop :=
  forall k mu rho pi lambda F V C R p state E l0 q e l k_num l0 b0 delta0 D0,
  (sigma = runtime_state_value k mu rho pi) ->
  NatMap.find p pi = Some (process_value (enclave_state_value state E) l0 q) ->
  NatMap.find e E = Some (enclave_address_and_data l k_num) ->
  l0 = memory_address b0 delta0 -> NatMap.find b0 mu = Some D0
  (exists i, NatMap.find delta0 D0 = Some (memory_value_instruction i)) /\
  (forall n l' b' delta' D', n < k -> l' = add_to_memory_address mu l n -> l' = memory_address b' delta' ->
  NatMap.find b' mu = Some D' -> exists n_k, NatMap.find delta' D' = Some (memory_value_data n_k)).


Require SF_imp.
Require SF_spec.
Require Import SF_lemma.
Require Import SF_properties.
Require Import SF_opt.
Require Import RelDec.
Require Import List.
Require Import Sorted.
Require Import Permutation.
Require Import FunctionalExtensionality.
Require Import Classical.
Require Import SF_tactic.
Require Import Coq.Numbers.BinNums.
Require Import Coq.NArith.BinNat.
Require Import Omega.

Import ListNotations.

Section cand.

Variable candidate : Set.
Variable reldec_candidate : RelDec (@Logic.eq candidate).
Variable reldec_correct_candidate : RelDec_Correct reldec_candidate.

Local Open Scope N_scope.

Ltac solve_rcv := SF_tactic.solve_rcv reldec_correct_candidate.
Ltac intuition_nosplit := SF_tactic.intuition_nosplit reldec_correct_candidate.

Lemma no_viable_candidates_correct :
forall rec bal,
SF_imp.no_viable_candidates candidate _ rec bal = true ->
SF_spec.no_viable_candidates candidate (in_record rec) bal.
Proof.
solve_rcv.
specialize (H _ H0). solve_rcv.
apply H in H1.
Unset Ltac Debug.
solve_rcv.
Qed.

Lemma eliminated_correct :
forall rec can,
SF_imp.eliminated candidate _ rec can = true <->
in_record rec can.
Proof.
split; solve_rcv.
 exists x. solve_rcv. intuition.
 exists can.  solve_rcv.
Qed.

Ltac force_specialize P :=
repeat
match goal with
| [ H : _ |- _] => extend (P H)
end.

Ltac force_specialize_all :=
repeat
match goal with
| [ H : (forall x, _) |- _ ] => progress (force_specialize H)
end.

Lemma next_ranking_not_overvote :
forall rec bal cd bal' a,
SF_imp.next_ranking candidate _ rec (a :: bal) = Some (cd, bal') ->
~SF_spec.overvote candidate a.
Proof.
intros. intro.
simpl in *.
destruct a; solve_rcv;
force_specialize_all;
simpl in *; intuition; subst; solve_rcv.
Qed.

Lemma next_ranking_selects : forall a bal cd bal' rec,
    SF_imp.next_ranking candidate reldec_candidate rec (a :: bal) =
    Some (cd, bal') ->
    SF_spec.does_not_select candidate (in_record rec) a ->
    SF_imp.next_ranking candidate reldec_candidate rec (bal) = Some (cd, bal').
Proof.
intros.
destruct a; simpl in *; solve_rcv.
destruct H0; solve_rcv.
assert (x=cd).
simpl in H0; intuition; force_specialize_all; solve_rcv.
subst. clear H0.
force_specialize_all; solve_rcv.
force_specialize_all; solve_rcv.
Qed.

Hint Resolve next_ranking_not_overvote : rcv.

Lemma next_ranking_correct :
forall rec bal cd bal' ,
SF_imp.next_ranking candidate _ rec bal = Some (cd, bal') ->
exists h t,(SF_spec.next_ranking candidate (in_record rec) bal (h::t) /\ Forall (Logic.eq cd) (h::t)).
Proof.
intros.
induction bal.
- solve_rcv.
- solve_rcv.
  destruct (SF_spec.ranking_cases _  (in_record rec) a); [ | destruct H0].
  + apply next_ranking_not_overvote in H. intuition.
  + solve_rcv. destruct a; simpl in *; solve_rcv.
    * { destruct H1.
        - exfalso. apply H2.
          subst. exists x2. auto.
        - exists x0; exists (x1); solve_rcv.
          + constructor; solve_rcv.
            * exists x2. split; auto.
              destruct H7. subst; auto.
              force_specialize_all; solve_rcv.
            * force_specialize_all; solve_rcv.
      }
    * { destruct H1.
        - subst. exists x. exists a. solve_rcv.
          eapply SF_spec.next_ranking_valid; solve_rcv.
        - exists cd.  exists a.
          solve_rcv. eapply SF_spec.next_ranking_valid; solve_rcv.
          simpl in H1. intuition.
          force_specialize_all; solve_rcv.
      }
  + apply next_ranking_selects in H; auto.
    solve_rcv.
    exists x; solve_rcv. exists x0.
    destruct H0; solve_rcv. constructor; solve_rcv.
    constructor; solve_rcv. force_specialize_all; solve_rcv.
    force_specialize_all; solve_rcv.
Qed.

Lemma next_ranking_viable :
forall bal rec cd bal',
SF_imp.next_ranking candidate reldec_candidate rec bal =
      Some (cd, bal') ->
~SF_spec.no_viable_candidates candidate (in_record rec) bal.
Proof.
induction bal; intros.
- simpl in *. congruence.
- simpl in *. destruct a.
  + intro. apply no_viable_candidates_cons in H0. destruct H0.
    eapply IHbal in H1; eauto.
  + destruct (forallb (eq_dec c) a).
    * { destruct (SF_imp.eliminated candidate reldec_candidate rec c) eqn:?.
        - apply eliminated_correct in Heqb.
          intro. apply no_viable_candidates_cons in H0.
          destruct H0.
          eapply IHbal in H1; eauto.
        - inv H. intro. apply no_viable_candidates_cons in H. destruct H.
          unfold SF_spec.no_viable_candidates in H.
          specialize (H (cd :: a)). simpl in H. intuition. clear H2.
          specialize (H cd). intuition. clear H2.
          rewrite <- eliminated_correct in H. congruence.
      }
    * congruence.
Qed.

Lemma next_ranking_selected :
forall bal cd bal' rec,
SF_imp.next_ranking candidate _ rec bal = Some (cd, bal') ->
SF_spec.selected_candidate candidate (in_record rec) bal cd.
solve_rcv.
- destruct H0.
 + apply H0; clear H0.
   apply next_ranking_correct in H.
   solve_rcv.
 + destruct bal; solve_rcv.
   copy H.
   apply next_ranking_correct in H. solve_rcv.
   unique; subst.
   force_specialize_all; solve_rcv.
- apply next_ranking_correct in H; solve_rcv.
  exists (x :: x0); solve_rcv.  simpl in *.
  force_specialize_all; solve_rcv; intuition.
Qed.

Lemma next_ranking_eliminated :
forall bal rec,
SF_imp.next_ranking candidate _ rec bal = None ->
SF_spec.exhausted_ballot candidate (in_record rec) bal.
Proof.
intros.
induction bal.
- left. solve_rcv.
- simpl in *. destruct a; solve_rcv.
  + destruct IHbal; solve_rcv.
    * left. intro. apply H0. solve_rcv.
      exists x. inv H1; solve_rcv.
    * right. exists x. solve_rcv. constructor; solve_rcv.
  + destruct IHbal.
    * left. intro. apply H2; solve_rcv.
      { inv H3.
        - solve_rcv.
        - destruct H8; solve_rcv.
          + exfalso. simpl in *. repeat (intuition; subst); force_specialize_all; solve_rcv.
          + inv H6; solve_rcv.
            * exfalso. apply H3. clear H3. exists x; solve_rcv.
            * force_specialize_all. solve_rcv.
              exfalso. apply H3; solve_rcv.
      }
    * right. solve_rcv.
      exists x1; solve_rcv.
      constructor; solve_rcv. exists x; inv H6; force_specialize_all; solve_rcv.
      simpl in *. intuition; force_specialize_all; solve_rcv.
  + right. clear IHbal. exists (c::a). solve_rcv.
    eapply SF_spec.next_ranking_valid. simpl. auto.
    left. solve_rcv. exists x. exists c.
    simpl. auto.
    exists x. exists c. simpl. auto.
Qed.

Definition boolCmpToProp {A} (c : A -> A -> bool) :=
fun a b => match c a b with
           | true => True
           | false => False
end.

Lemma insert_sorted : forall {A} c sorted (a : A),
    (forall a b, c a b = false -> c b a = true) ->
    Sorted (boolCmpToProp c) sorted ->
    Sorted (boolCmpToProp c) (SF_imp.insert c a sorted).
intros.
induction H0.
- simpl. auto.
- simpl.
  destruct (c a a0) eqn:?.
  constructor. auto. constructor. unfold boolCmpToProp. rewrite Heqb. auto.
  constructor. auto.
  clear IHSorted H0.
  induction l.
  + simpl in *.
    constructor. unfold boolCmpToProp. apply H in Heqb. rewrite Heqb.
    auto.
  + simpl in *. destruct (c a a1) eqn:?. constructor. apply H in Heqb.
    unfold boolCmpToProp. rewrite Heqb. auto.
    constructor; auto.
    unfold boolCmpToProp.
    apply H in Heqb. inv H1. unfold boolCmpToProp in H2.
    auto.
Qed.

Lemma insertion_sort_sorted' : forall {A} (l : list A) (sorted : list A) c,
    (forall a b, c a b = false -> c b a = true) ->
    Sorted (boolCmpToProp c) sorted ->
    Sorted (boolCmpToProp c) (SF_imp.insertionsort' c l sorted).
Proof.
induction l.
+ intros. simpl. auto.
+ intros. simpl in *. apply IHl; auto.
  apply insert_sorted; auto.
Qed.

Lemma insertion_sort_sorted : forall {A} (l : list A) c,
    (forall a b, c a b = false -> c b a = true) ->
    Sorted (boolCmpToProp c) (SF_imp.insertionsort c l).
intros.
apply insertion_sort_sorted'; auto.
Qed.

Lemma insert_permutation :
  forall {A} l2 l1  (a : A) c,
    Permutation l1 l2 ->
    Permutation (a :: l1) (SF_imp.insert c a l2).
Proof.
induction l2; intros.
- apply Permutation_sym in H. apply Permutation_nil in H. subst. simpl in *. auto.
- simpl in *. destruct (c a0 a).
  constructor. auto.
  eapply Permutation_trans. instantiate (1:= (a0 :: a :: l2)).
  auto. rewrite perm_swap. constructor.
  apply IHl2. auto.
Qed.

Lemma insertion_sort_permutation' :
  forall {A} (le ls : list A) c sorted,
    Permutation ls sorted ->
    Permutation (ls ++ le) (SF_imp.insertionsort' c le sorted).
Proof.
induction le; intros.
- simpl in *. rewrite app_nil_r. auto.
- simpl. rewrite <- Permutation_middle.
  rewrite app_comm_cons.
  apply IHle. apply insert_permutation. auto.
Qed.

Lemma insertion_sort_permutation :
  forall {A} (l : list A) c,
    Permutation l (SF_imp.insertionsort c l).
intros. rewrite <- app_nil_l at 1.
unfold SF_imp.insertionsort.
apply insertion_sort_permutation'. auto.
Qed.

Definition tb_func_to_Prop {c : Set} (f : list c -> option c) :=
fun l cd => match f l with
         | Some x => x = cd
         | None => False
end.

Lemma in_split : forall A B (f : A) (l : list (A * B)),
              In f (fst (split l)) ->
              exists n : B, In (f, n) l.
Proof.
induction l; intros.
- simpl in *. inv H.
- simpl in *. destruct a. simpl in *.
  destruct (split l) eqn:?.
  simpl in *. destruct H.
  + subst. eauto.
  + intuition. destruct H0. eauto.
Qed.

Lemma rel_dec_refl : forall c, rel_dec c c = true.
Proof.
intros. apply rel_dec_correct. auto.
Qed.

Lemma increment_spec : forall (m : list (candidate *  N)) cd cds (ct : N),
cds = (fst (split m)) ->
NoDup (cds) ->
(In (cd, ct) m -> In (cd, (ct + 1)%N) (SF_imp.increment candidate _ m cd)) /\
(~In cd cds -> In (cd, 1%N) (SF_imp.increment candidate _ m cd)).
Proof.
induction m; intros.
- simpl in *. intuition.
- simpl in *. destruct a.
  destruct (split m) eqn:?.
  simpl in *.
  destruct (in_dec rel_dec_p cd cds).
  + subst.
    split.
    * { intros. simpl in *.
        unfold eq_dec.
        intuition.
        - inv H2.  rewrite rel_dec_refl.
          simpl. auto.
        - subst. clear -Heqp H2 H0.
          inv H0. assert (In cd l). apply in_split_l in H2.
          simpl in H2. rewrite Heqp in *. auto.
          intuition.
        - inv H2. inv H0. intuition.
        - assert (c <> cd).
          intro. subst. inv H0. intuition.
          eapply rel_dec_neq_false in H.
          rewrite H. simpl. right.
          edestruct IHm. reflexivity.
          inv H0; auto.
          clear H4. auto. apply reldec_correct_candidate.
      }
    * intuition.
  + subst. simpl in *. inv H0. unfold eq_dec.
    split.
      * { intuition.
        - inv H0. intuition.
        - eapply rel_dec_neq_false in H. rewrite H.
          edestruct IHm; eauto. simpl in *. auto.
          apply reldec_correct_candidate.
        }
      * intuition. eapply rel_dec_neq_false in H4. rewrite H4.
        simpl.
        edestruct IHm; eauto.
        eapply reldec_correct_candidate.
Grab Existential Variables. exact 0.
Qed.

Lemma increment_not_0 : forall running cd,
NoDup (fst (split running)) ->
~In (cd, 0) (SF_imp.increment candidate reldec_candidate running cd).
Proof.
induction running; intros; intro.
- unfold SF_imp.increment in *. simpl in *; intuition. congruence.
- simpl in *. destruct a. destruct (eq_dec c cd) eqn:?.
  + clear IHrunning. apply reldec_correct_candidate in Heqb. subst.
    simpl in *. destruct (split running) eqn:?. simpl in *.
    inv H. intuition. inv H. rewrite N.add_comm in H1. rewrite N.eq_add_0 in H1.
    intuition. congruence.  apply in_split_l in H.
    simpl in H. rewrite Heqp in H. simpl. intuition.
  + simpl in *. destruct (split running) eqn:?. simpl in *.
    apply neg_rel_dec_correct in Heqb. destruct H0.
    * inv H0. auto.
    * inv H. intuition. eapply IHrunning; eauto.
Qed.

Lemma increment_nodup' : forall running cd c,
~In c (fst (split running)) ->
c <> cd ->
~In c (fst (split (SF_imp.increment candidate reldec_candidate running cd))).
Proof.
induction running; intros.
- simpl in *. intuition.
- simpl in *.
  destruct a.
  destruct (split running) eqn:?. simpl in H. intuition.
  destruct (eq_dec c0 cd) eqn:?.
  + simpl in *. rewrite Heqp in *. simpl in *. intuition.
  + simpl in *. destruct (split
                   (SF_imp.increment candidate reldec_candidate running cd)) eqn:?.
    simpl in *. intuition. eapply IHrunning; eauto.
    rewrite Heqp0. simpl. auto.
Qed.

Lemma increment_nodup : forall running cd,
NoDup (fst (split running)) ->
NoDup (fst (split (SF_imp.increment candidate reldec_candidate running cd))).
induction running; intros.
- simpl in *. constructor; auto.
- simpl in *. destruct a. destruct (eq_dec c cd) eqn:?.
  + apply reldec_correct_candidate in Heqb. subst.
    simpl in *.
    destruct (split running) eqn:?. simpl in *. auto.
  + simpl in *. destruct ( split (SF_imp.increment candidate reldec_candidate running cd)) eqn:?.
    simpl.
    destruct (split running) eqn:?. simpl in *. inv H.
    eapply IHrunning in H3. instantiate (1:=cd) in H3. rewrite Heqp in H3.
    simpl in H3. constructor; auto. intro. apply neg_rel_dec_correct in Heqb.
    eapply increment_nodup'; eauto. instantiate (1:=running).
    rewrite Heqp0. simpl. auto.
    rewrite Heqp. auto.
Qed.

Lemma increment_neq : forall running c cd v,
In (c, v) running ->
c <> cd ->
In (c, v) (SF_imp.increment candidate reldec_candidate running cd).
Proof.
induction running; intros.
- inv H.
- destruct a.
  simpl in *.
  destruct (eq_dec c0 cd) eqn:?.
  + simpl in *. intuition.
    apply reldec_correct_candidate in Heqb. inv H1. subst. intuition.
  + simpl in *. intuition.
Qed.

Lemma increment_neq' : forall running cd ct  c,
In (cd, ct) (SF_imp.increment candidate reldec_candidate running c) ->
c <> cd ->
In (cd, ct) running.
Proof.
induction running; intros.
- simpl in H. intuition. congruence.
- simpl in *. destruct a.
  + destruct (eq_dec c0 c) eqn:?.
    apply rel_dec_correct in Heqb. subst.
    simpl in *. intuition. inv H1. intuition.
    simpl in *. intuition.
    right. eapply IHrunning; eauto.
Qed.

Lemma tabulate''_not_0 : forall l cd v running,
NoDup (fst (split running)) ->
In (cd, v) running ->
v <> 0 ->
~In (cd, 0)
   (SF_imp.tabulate'' candidate reldec_candidate l running).
Proof.
induction l; intros.
- simpl in *. intuition. apply H1.
  clear H1. induction running.
  + inv H0.
  + simpl in *. destruct a. destruct (split running) eqn:?. simpl in *.
    intuition.
    * inv H1. inv H0. auto.
    * inv H1. inv H. intuition. apply in_split_l in H0. simpl in *.
      rewrite Heqp in *. simpl in *. intuition.
    * inv H. inv H0. apply in_split_l in H1. rewrite Heqp in *. simpl in *.
      intuition.
    * inv H. intuition.
- simpl in *. destruct a. intro. intuition.
  destruct (rel_dec_p c cd).
  + subst.
    eapply IHl in H2; auto.
    * apply increment_nodup. auto.
    * instantiate (1:=v + 1). edestruct increment_spec. reflexivity.
      apply H. apply H3. auto.
    * intuition.  rewrite N.eq_add_0 in H3. destruct H3. congruence.
  + eapply IHl in H2; auto.
    * apply increment_nodup; auto.
    * instantiate (1:=v). edestruct increment_spec. reflexivity.
      apply H. apply increment_neq; auto.
    * auto.
  + eapply IHl in H0; auto.
Grab Existential Variables. apply 0. apply c. (*ugh*)
Qed.

Lemma tabulate''_not_0_also : forall l cd running,
NoDup (fst (split running)) ->
(forall v,
   In (cd, v) running ->
   v <> 0) ->
~In (cd, 0)
   (SF_imp.tabulate'' candidate reldec_candidate l running).
Proof.
  induction l; simpl; repeat intro.
  * apply H0 in H1. apply H1; auto.
  * destruct a.
    revert H1. apply IHl.
    apply increment_nodup; auto.
    intros.
    intro. subst v.
    case_eq (eq_dec cd c); intros.
    apply reldec_correct_candidate in H2. subst c.
    eapply increment_not_0. 2: apply H1. auto.
    apply increment_neq' in H1.
    apply H0 in H1. elim H1; auto.
    intro.
    subst c.
    assert (eq_dec cd cd = true).
    apply reldec_correct_candidate. auto.
    rewrite H2 in H3. discriminate.
    eapply IHl; eauto.
Qed.

Lemma tabulate_not_0 : forall l cd r ,
~In (cd, 0)
   (fst (SF_imp.tabulate candidate reldec_candidate r l)).
Proof.
  intros.
  unfold SF_imp.tabulate.
  destruct (SF_imp.option_split
               (map (SF_imp.next_ranking candidate reldec_candidate r) l)).
  simpl.
  intro.
  generalize (insertion_sort_permutation
                (SF_imp.tabulate' _ reldec_candidate l0) (SF_imp.cnle candidate)).
  intros.
  assert (In (cd, 0) (SF_imp.tabulate' _ reldec_candidate l0)).
  eapply Permutation_in. 2: apply H.
  apply Permutation_sym. auto.
  unfold SF_imp.tabulate' in H1.
  eapply (tabulate''_not_0_also l0 cd); eauto.
  simpl. constructor.
  simpl; intuition.
Qed.

Lemma opt_eq_dec : forall A,
(forall (a b : A), {a = b} + {a <> b}) ->
forall (a b : option A), {a = b} + {a <> b}.
Proof.
intros.
destruct a, b; auto.
specialize (X a a0). destruct X. subst. auto. right.
intro. inv H. auto.
right. intro. congruence.
right. congruence.
Qed.

Lemma opt_eq_dec_cand :
forall (a b : option candidate), {a = b} + {a <> b}.
Proof.
apply opt_eq_dec. apply rel_dec_p.
Qed.

Lemma NoDup_In_fst :
forall A B l (a :A) (b :B) c,
NoDup (fst (split l)) ->
In (a, b) l ->
In (a, c) l ->
b = c.
Proof.
induction l; intros.
- inv H0.
- simpl in *.
  destruct (split l) eqn:?.
  destruct a. intuition; try congruence.
  + simpl in *. inv H2. inv H. apply in_split_l in H0. simpl in H0.
    rewrite Heqp in *. intuition.
  + simpl in *. inv H. inv H0.
    apply in_split_l in H2. simpl in*. rewrite Heqp in *.
    intuition.
  + eapply IHl; eauto. simpl. simpl in H. inv H. auto.
Qed.

Lemma tab_inc_s : forall cd ct l running running' cr,
NoDup (fst (split running)) ->
NoDup (fst (split running')) ->
In (cd, ct + 1)
   (SF_imp.tabulate'' candidate reldec_candidate l running') ->
In (cd, cr) running ->
In (cd, (cr + 1)) running' ->
In (cd, ct) (SF_imp.tabulate'' candidate reldec_candidate l running).
Proof.
induction l; intros.
- simpl in *.
  assert (cr = ct).
  eapply NoDup_In_fst in H3. instantiate (1:= ct + 1) in H3.
  apply N.add_cancel_r in H3. auto.
  auto. auto. subst. auto.
- simpl in *.
  destruct a.
  + destruct (rel_dec_p cd c).
    * subst. eapply IHl.
      apply increment_nodup. auto.
      apply increment_nodup. apply H0.
      eauto.
      eapply increment_spec in H2; eauto.
      eapply increment_spec in H3; eauto.
    * eapply increment_neq in H2; eauto.
      eapply increment_neq in H3; eauto.
      eapply IHl.
      apply increment_nodup. auto.
      apply increment_nodup. apply H0.
      apply H1.
      eauto.
      eauto.
  + eapply IHl; eauto.
Qed.

Lemma tabulate''_same : forall cd l running running' cr ct,
NoDup (fst (split running)) ->
NoDup (fst (split running')) ->
In (cd, cr) running ->
In (cd, cr) running' ->
In (cd, ct) (SF_imp.tabulate'' candidate reldec_candidate l running) ->
In (cd, ct) (SF_imp.tabulate'' candidate reldec_candidate l running').
Proof.
induction l; intros.
- simpl in *.
  assert (cr = ct).
  eapply NoDup_In_fst. apply H.
  apply H1. apply H3. subst.
  auto.
- simpl in *.
  destruct a.
  + destruct (rel_dec_p cd c).
    * eapply IHl.
      apply increment_nodup. apply H.
      apply increment_nodup. auto.
      subst.
      eapply increment_spec in H1. apply H1.
      auto. auto.
      subst. eapply increment_spec in H2; eauto.
      eauto.
    * eapply IHl.
      apply increment_nodup. apply H.
      apply increment_nodup. auto.
      eapply increment_neq in n. apply n. eauto.
      eapply increment_neq in n.
      eauto. auto.
      eauto.
  + eapply IHl; eauto.
Qed.

Lemma tabulate''_same_notin : forall cd ct l running running',
NoDup (fst (split running)) ->
NoDup (fst (split running')) ->
~In cd (fst (split running)) ->
~In cd (fst (split running')) ->
In (cd, ct) (SF_imp.tabulate'' candidate reldec_candidate l running) ->
In (cd, ct) (SF_imp.tabulate'' candidate reldec_candidate l running').
Proof.
induction l; intros.
- simpl in *. intuition.
  apply in_split_l in H3. simpl in H3. intuition.
- simpl in *.
  destruct a; try solve [eapply IHl; eauto].
  destruct (rel_dec_p cd c).
  + subst. eapply increment_spec in H1; eauto.
    eapply increment_spec in H2; eauto.
    eapply (tabulate''_same _ _ _ _ _ _ _ _ _ H2).
    eauto.
  + eapply IHl. apply H.
    apply increment_nodup. auto. auto. apply increment_nodup'; eauto.
    eapply IHl in H3. eauto.
    apply increment_nodup. auto. auto. apply increment_nodup'; eauto.
    auto. Grab Existential Variables. auto.
    apply increment_nodup. auto. apply increment_nodup. auto.
Qed.

Lemma tab_inc_s_l :
forall l cd ct running,
In (cd, ct + 1) (SF_imp.tabulate'' candidate reldec_candidate l
               (SF_imp.increment candidate reldec_candidate running cd)) ->
~ In cd (fst (split running)) ->
NoDup (fst (split running)) ->
In (Some cd) l ->
In (cd, ct) (SF_imp.tabulate'' candidate reldec_candidate l running).
Proof.
induction l; intros.
- inv H2.
- simpl in *. destruct a.
  destruct (rel_dec_p cd c).
  + subst. clear H2.
    simpl in *. eapply increment_spec in H0; auto.
    copy H0.
    eapply increment_spec in H0; auto.
    eapply tab_inc_s. apply increment_nodup. auto. apply increment_nodup.
    apply increment_nodup. eauto. eauto. eauto. eauto.
    apply increment_nodup. auto.
  + destruct H2. congruence.
    eapply tabulate''_same_notin.
    eauto. apply increment_nodup. auto.
    auto.
    apply increment_nodup'; auto.
    eapply IHl; eauto.
    eapply (tabulate''_same) in H.
    apply H. apply increment_nodup. apply increment_nodup.
    auto. apply increment_nodup. auto.
    apply increment_neq; auto. eapply increment_spec in H0; eauto.
    eapply increment_spec in H0; eauto.
  + intuition. congruence.
Qed.

Lemma tabulate_not_in_l :
forall l cd ct running,
NoDup (fst (split running)) ->
In (cd, ct) running ->
~In (Some cd) l ->
In (cd, ct) (SF_imp.tabulate'' candidate reldec_candidate l running).
Proof.
induction l; intros.
- simpl. auto.
- simpl in *.
  destruct a; intuition; try congruence.
  eapply IHl; eauto. apply increment_nodup. auto.
  apply increment_neq; auto. intuition. subst. auto.
Qed.

Lemma tabulate_nodup :
forall l running,
NoDup (fst (split running)) ->
NoDup (fst (split (SF_imp.tabulate'' candidate reldec_candidate l running))).
Proof.
induction l; intros.
- simpl.  auto.
- simpl in *.
  destruct a.
  + apply IHl. apply increment_nodup; auto.
  + apply IHl. auto.
Qed.

Lemma selected_not_in :
forall  ef l cd r l0,
~(In (Some cd ) l) ->
SF_imp.option_split
           (map (SF_imp.next_ranking candidate reldec_candidate r) ef) =
         (l, l0) ->
SF_spec.first_choices candidate (in_record r) cd ef 0.
Proof.
induction ef; intros.
- simpl in *. inv H0. constructor.
- simpl in *.
  destruct (SF_imp.next_ranking candidate reldec_candidate r a) eqn:?.
  + destruct p. destruct (SF_imp.option_split
                            (map (SF_imp.next_ranking candidate reldec_candidate r) ef)) eqn:?.
    simpl in *. inv H0. simpl in *.
    intuition.
    apply next_ranking_selected in Heqo.
    constructor.
    intro. eapply SF_spec.selected_candidate_unique in Heqo; eauto.
    subst; auto.
    eapply IHef; eauto.
  + destruct (SF_imp.option_split
              (map (SF_imp.next_ranking candidate reldec_candidate r) ef)) eqn:?.
    inv H0.
    simpl in *.
    apply SF_spec.first_choices_not_selected.
    intro. intuition. unfold SF_spec.selected_candidate in H0.
    destruct H0. apply next_ranking_eliminated in Heqo.
    unfold SF_spec.continuing_ballot in H. intuition.
    eapply IHef; eauto.
Qed.

Lemma increment_same_s :
forall c running,
NoDup (fst (split running)) ->
exists n, In (c, n + 1) (SF_imp.increment candidate _ running c).
intros.
destruct (in_dec rel_dec_p c (fst (split running))).
apply in_split in i. destruct i.
exists x. eapply increment_spec in H; eauto.
destruct H. apply H. auto.
exists 0. eapply increment_spec in n; eauto. apply 0.
Qed.

Lemma tabulate''_first_choices : forall ef cd ct es running r
(NODUP : NoDup (fst (split running))),
In (cd, ct) (SF_imp.tabulate'' candidate _
                (fst (SF_imp.option_split
                  (map (SF_imp.next_ranking candidate reldec_candidate r)
                       ef))) running) ->
(forall cnd, ~In cnd (fst (split running)) ->
             SF_spec.first_choices candidate (in_record r) cnd es 0) ->
Forall (fun x => let (cnd, n) := (x: candidate * N)
                 in SF_spec.first_choices candidate (in_record r) cnd es (N.to_nat n)) running ->
SF_spec.first_choices candidate (in_record r) cd (es ++ ef) (N.to_nat ct).
Proof.
induction ef; intros.
- simpl in *. rewrite Forall_forall in *. specialize (H1 _ H). simpl in H1.
  rewrite app_nil_r.  auto.
- simpl in H.
  assert (Permutation (a :: (es ++ ef)) (es ++ a :: ef)).
  apply Permutation_middle.
  eapply first_choices_perm; eauto. clear H2.
  destruct (SF_imp.next_ranking candidate reldec_candidate r a) eqn:?.
  +  destruct p. destruct (SF_imp.option_split
                     (map (SF_imp.next_ranking candidate reldec_candidate r)
                          ef)) eqn:?. simpl in *.
     apply next_ranking_selected in Heqo.
     destruct (rel_dec_p c cd).
     * subst.
       { destruct ct.
         - clear - H NODUP.
           assert (X := increment_same_s cd running NODUP).
           destruct X.
           exfalso. eapply tabulate''_not_0; [ | | | apply H]; eauto.
           apply increment_nodup. auto. intro. rewrite N.eq_add_0 in H1. intuition; congruence.
         - assert (exists p', N.to_nat (N.pos p) = S p').
           rewrite Znat.positive_N_nat.
           apply Pnat.Pos2Nat.is_succ. destruct H2. rewrite H2 in *.
           apply SF_spec.first_choices_selected; auto.
           destruct (in_dec rel_dec_p cd (fst (split running))).
           + rewrite <- (Nnat.Nat2N.id x). eapply IHef; eauto.
             edestruct in_split. apply i.
             eapply tab_inc_s; auto.
             apply increment_nodup. eauto.
             rewrite Heqp. simpl.
             assert (N.of_nat x+1 = N.pos p).
             assert (1 = (N.of_nat 1)). auto. rewrite H4.
             rewrite <- Nnat.Nat2N.inj_add.
             rewrite Plus.plus_comm. simpl (1 + x)%nat.
             rewrite <- H2. rewrite Nnat.N2Nat.id. auto.
             rewrite H4.
             eauto.
             apply H3. eapply increment_spec in H3; eauto.
           + destruct (in_dec opt_eq_dec_cand (Some cd) l).
             * rewrite <- (Nnat.Nat2N.id x).
               eapply IHef; eauto.
               rewrite Heqp. simpl.
               apply tab_inc_s_l; auto.
               assert (N.of_nat x+1 = N.pos p).
               assert (1 = (N.of_nat 1)). auto. rewrite H3.
               rewrite <- Nnat.Nat2N.inj_add.
               rewrite Plus.plus_comm. simpl (1 + x)%nat.
               rewrite <- H2. rewrite Nnat.N2Nat.id. auto.
               rewrite H3.
               eauto.
             * copy n. eapply increment_spec in n; eauto.
               eapply tabulate_not_in_l in n; eauto.
               assert (1 = (Npos p)). eapply NoDup_In_fst; [ | eauto | eauto ].
               apply tabulate_nodup. apply increment_nodup. auto.
               assert (1%nat = (S x)). rewrite <- H2.
               rewrite <- H4. simpl. auto.
               rewrite <- H4 in *. inv H5.
               change 0%nat with (0 + 0)%nat.
               { apply first_choices_app.
                 - apply H0. auto.
                 - eapply selected_not_in; eauto.
               }
               apply increment_nodup; auto. constructor.
       }
     * apply SF_spec.first_choices_not_selected. intro.
       apply n. eapply SF_spec.selected_candidate_unique; eauto.
       { destruct (in_dec rel_dec_p cd (fst (split running))).
         - copy i. apply in_split in H2. destruct H2.
           eapply IHef; eauto.
           rewrite Heqp. simpl. eapply tabulate''_same in H; eauto.
           eauto.
           apply increment_nodup. auto.
           apply increment_neq; auto.
         - eapply IHef; eauto.
           rewrite Heqp. simpl.
           eapply tabulate''_same_notin in H.
           eauto. apply increment_nodup. auto.
           auto. intro.
           apply in_split in H2.
           destruct H2.
           apply n0.
           eapply increment_neq' in H2.
           apply in_split_l in H2. auto.
           auto. auto.
       }
  + destruct ( SF_imp.option_split
                 (map (SF_imp.next_ranking candidate reldec_candidate r)
                      ef)) eqn:?.
    simpl in *.
    apply next_ranking_eliminated in Heqo.
    apply SF_spec.first_choices_not_selected.
    intro. unfold SF_spec.selected_candidate in H2.
    intuition.
    eapply IHef; eauto. rewrite Heqp. simpl. auto.
Qed.

Lemma tabulate'_first_choices : forall l cd ct  r,
In (cd, ct) (SF_imp.tabulate' _ _ (fst (SF_imp.option_split
                                      (map (SF_imp.next_ranking candidate reldec_candidate r)
                                           l)))) ->
SF_spec.first_choices candidate (in_record r) cd (l) (N.to_nat ct).
Proof.
intros.
rewrite <- app_nil_l at 1.
eapply tabulate''_first_choices in H. eauto.
constructor.
intros. constructor.
constructor.
Qed.

Lemma tabulate_correct : forall rec election rs election',
SF_imp.tabulate candidate _ rec election = (rs, election') ->
Forall (fun (x: (candidate * N)) => let (cd, fc) := x in
                 SF_spec.first_choices candidate (in_record rec) cd election (N.to_nat fc)) rs.
Proof.
intros.
unfold SF_imp.tabulate in H. destruct (SF_imp.option_split
             (map (SF_imp.next_ranking candidate reldec_candidate rec)
                election)) eqn:?.
assert (PRM := insertion_sort_permutation (SF_imp.tabulate' candidate reldec_candidate l)
                                          (SF_imp.cnle candidate)).
rewrite Forall_forall. intros. destruct x. destruct ((SF_imp.insertionsort (SF_imp.cnle candidate)
         (SF_imp.tabulate' candidate reldec_candidate l),
      SF_imp.drop_none l0)) eqn:?. inv H.
inv Heqp0.
apply Permutation_sym in PRM.
eapply Permutation_in in PRM; eauto.
assert (l = fst (SF_imp.option_split
           (map (SF_imp.next_ranking candidate reldec_candidate rec) election))).
rewrite Heqp. auto.  subst.
clear H0.
apply tabulate'_first_choices in PRM. auto.
Qed.

(*Lemma leb_false :
forall n0  n,
NPeano.leb n0 n = false ->
n <= n0.
Proof.
induction n0; intros.
- inv H.
- simpl in *.  destruct n.
  omega.
  apply IHn0 in H. omega.
Qed.*)

Lemma tabulate_sorted :
forall rec election rs election',
SF_imp.tabulate _ _ rec election = (rs, election') ->
Sorted (boolCmpToProp (SF_imp.cnle candidate)) rs.
Proof.
intros.
intros.
unfold SF_imp.tabulate in H. destruct (SF_imp.option_split
             (map (SF_imp.next_ranking candidate reldec_candidate rec)
                election)) eqn:?.
inv H. apply insertion_sort_sorted.
intros. unfold SF_imp.cnle. destruct b.
destruct a. simpl in *. rewrite N.leb_le in *.
rewrite N.leb_gt in *. apply N.lt_le_incl in H. auto.
Qed.

Lemma increment_not_eliminated :
forall vs c rec,
~(in_record rec c) ->
Forall (fun cd =>  ~(in_record rec cd)) (fst (split vs)) ->
Forall (fun cd => ~(in_record rec cd)) (fst (split (SF_imp.increment candidate _ vs c))).
Proof.
induction vs; intros.
- simpl in *. auto.
- simpl in *. rewrite Forall_forall in *.
  intros. destruct a.
  destruct (eq_dec c0 c) eqn:?.
  + simpl in *. destruct (split vs) eqn:?.
    simpl in *. intuition. subst. apply reldec_correct_candidate in Heqb.
    subst. intuition.
    specialize (H0 x). intuition.
  + simpl in *. destruct (split (SF_imp.increment candidate reldec_candidate vs c)) eqn:?.
    simpl in *. intuition.
    * subst. specialize (H0 x).
      destruct (split vs) eqn:?. simpl in *. intuition.
    * eapply IHvs in H; eauto.
      rewrite Forall_forall in H.
      eapply H; eauto.
      rewrite Heqp. auto.
      rewrite Forall_forall. intros.
      specialize (H0 x0). destruct (split vs).
      simpl in *. intuition.
Qed.

Lemma tabulate''_continuing : forall ef cd ct  running r,
In (cd, ct) (SF_imp.tabulate'' candidate _
                               (fst (SF_imp.option_split
                                      (map (SF_imp.next_ranking candidate reldec_candidate r)
                                           ef))) running) ->
Forall (fun x => ~(in_record r x)) (fst (split running)) ->
~(in_record r cd).
Proof.
induction ef; intros.
- simpl in *. rewrite Forall_forall in H0.
  specialize (H0 (cd)). intuition. apply H0; auto.
  apply in_split_l in H. simpl in H. auto.
- simpl in *. destruct ( SF_imp.next_ranking candidate reldec_candidate r a) eqn:?.
  + destruct p. apply next_ranking_selected in Heqo.
    destruct (SF_imp.option_split
                (map (SF_imp.next_ranking candidate reldec_candidate r)
                     ef)) eqn:?. simpl in *.
    apply SF_spec.selected_candidate_not_eliminated in Heqo.
    eapply increment_not_eliminated in Heqo; eauto.
    eapply IHef. rewrite Heqp. simpl. eauto.
    auto.
  + destruct (SF_imp.option_split
                (map (SF_imp.next_ranking candidate reldec_candidate r)
                     ef)) eqn:?.
    simpl in *.
    eapply IHef. rewrite Heqp. simpl. eauto.
    eauto.
Qed.

Lemma split_fst (A B:Type) (l:list (A*B)):
  map (@fst A B) l = fst (split l).
Proof.
  induction l; simpl; auto.
  destruct a; simpl.
  destruct (split l); simpl in *.
  f_equal; auto.
Qed.

Lemma increment_same :
  forall running cnd cnt,
    NoDup (fst (split running)) ->
    In (cnd,cnt) (SF_imp.increment candidate reldec_candidate running cnd) ->
    (exists cnt', cnt = cnt' + 1 /\ In (cnd,cnt') running) \/
    (cnt = 1 /\ ~In cnd (fst (split running))).
Proof.
  induction running; simpl; intuition.
  * inv H1. eauto.
  * revert H0. case_eq (eq_dec a0 cnd); intros.
    + simpl in H1. destruct H1.
      - inv H1.
        left. exists b. split; auto.
      - case_eq (split running); intros.
        rewrite H2 in H. simpl in H.
        inv H.
        apply reldec_correct_candidate in H0.
        subst a0.
        assert (In cnd (map (@fst _ _ ) running)).
        rewrite in_map_iff.
        exists (cnd,cnt). simpl; auto.
        rewrite split_fst in H.
        rewrite H2 in H. simpl in H.
        contradiction.
    + simpl in H1. destruct H1.
      - inv H1.
        assert (eq_dec cnd cnd = true).
        apply reldec_correct_candidate. auto.
        rewrite H0 in H1. discriminate.
      - apply IHrunning in H1.
        destruct H1.
        destruct H1 as [cnt' [??]].
        left. exists cnt'. split; simpl; auto.
        destruct H1.
        right; split; auto.
        destruct (split running); simpl in *.
        intro. intuition.
        assert (eq_dec a0 cnd = true).
        apply reldec_correct_candidate. auto.
        rewrite H0 in H3. discriminate.
        destruct (split running). simpl in *.
        inv H; auto.
Qed.

Lemma tabulate''_first_choices_complete : forall ef cd ct es running r
(NODUP : NoDup (fst (split running))),
(forall cnd cnt,
   (cnt <> 0 /\ SF_spec.first_choices candidate (in_record r) cnd es (N.to_nat cnt)) <->
   In (cnd, cnt) running) ->
ct <> 0 ->
SF_spec.first_choices candidate (in_record r) cd (es ++ ef) (N.to_nat ct) ->
In (cd, ct) (SF_imp.tabulate'' candidate _
                               (fst (SF_imp.option_split
                                      (map (SF_imp.next_ranking candidate reldec_candidate r)
                                           ef))) running).
Proof.
induction ef; intros.
- simpl in *.
  rewrite app_nil_r in *. apply H; auto.
- simpl in *.
  destruct (SF_imp.next_ranking candidate reldec_candidate r a) eqn:?.
  + destruct p. destruct (SF_imp.option_split
                  (map (SF_imp.next_ranking candidate reldec_candidate r) ef)) eqn:?.
    assert (l = fst ( SF_imp.option_split
           (map (SF_imp.next_ranking candidate reldec_candidate r) ef))) by (rewrite Heqp; auto).
    subst. simpl.
    assert (Permutation (es ++ a :: ef) (a :: (es ++ ef))).
    rewrite Permutation_middle. auto.
    eapply first_choices_perm in H1; eauto.
    clear H2.
    apply next_ranking_selected in Heqo; auto.
    apply (IHef cd ct (a::es) (SF_imp.increment candidate reldec_candidate running c) r); auto.
    { apply increment_nodup; auto. }
    { intros. split.
      * intros [??]. inv H3.
        + assert ( c = cnd ) by (eapply SF_spec.selected_candidate_unique; eauto).
          subst c.
          destruct (increment_spec running cnd (fst (split running)) (N.of_nat n')); auto.
          replace cnt with (N.of_nat n' + 1).
          assert (n' = 0 \/ n' <> 0)%nat by omega.
          destruct H5.
          subst n'.
          simpl in *.
          apply H4.
          { intro.
            rewrite <- split_fst in H5.
            rewrite in_map_iff in H5.
            destruct H5 as [[p q] [??]].
            simpl in *.
            subst p.
            apply H in H9. destruct H9.
            elim H5.
            apply Nnat.N2Nat.inj. simpl.
            eapply SF_spec.sf_first_choices_unique; eauto.
          }
          apply H3.
          rewrite <- H.
          split.
          intro.
          apply H5.
          destruct n'; auto.
          inv H9.
          rewrite Nnat.Nat2N.id. auto.
          apply Nnat.N2Nat.inj.
          rewrite <- H6.
          rewrite Nnat.N2Nat.inj_add.
          rewrite Nnat.Nat2N.id.
          rewrite Plus.plus_comm. simpl. auto.
        + apply increment_neq; auto.
          rewrite <- H. split; auto.
          intro. subst c. contradiction.
      * simpl; intros.
        destruct (classic (c = cnd)).
        subst c.
        split. intro. subst cnt.
        revert H2. apply increment_not_0; auto.
        apply increment_same in H2; auto.
        destruct H2.
        destruct H2 as [cnt' [??]].
        apply H in H3. destruct H3.
        replace (N.to_nat cnt) with (S (N.to_nat cnt')).
        apply SF_spec.first_choices_selected; auto.
        rewrite H2.
        rewrite N.add_comm.
        rewrite Nnat.N2Nat.inj_add. simpl. auto.
        destruct H2. subst cnt. unfold N.to_nat. unfold BinPos.Pos.to_nat. simpl.
        apply SF_spec.first_choices_selected; auto.
        destruct (SF_spec.sf_first_choices_total candidate (in_record r) es cnd).
        destruct x; auto.
        elim H3.
        rewrite <- split_fst.
        rewrite in_map_iff.
        exists (cnd, N.of_nat (S x)). split.
        simpl; auto.
        apply H.
        split. simpl. discriminate.
        rewrite Nnat.Nat2N.id. auto.

        apply increment_neq' in H2; auto.
        rewrite <- H in H2.
        destruct H2; split; auto.
        apply SF_spec.first_choices_not_selected; auto.
        intro. apply H3.
        eapply SF_spec.selected_candidate_unique; eauto.
    }

  + destruct (SF_imp.option_split
                  (map (SF_imp.next_ranking candidate reldec_candidate r) ef)) eqn:?.
    simpl.
    assert (l = fst ( SF_imp.option_split
           (map (SF_imp.next_ranking candidate reldec_candidate r) ef))) by (rewrite Heqp; auto).
    subst. simpl.
    assert (Permutation (es ++ a :: ef) (a :: (es ++ ef))).
    rewrite Permutation_middle. auto.
    eapply first_choices_perm in H1. 2: apply H2.
    clear H2.
    inv H1.
    * apply next_ranking_eliminated in Heqo.
      destruct H5. elim H1; auto.
    * apply (IHef cd ct (a::es) running r); auto.
      { intros; split.
        intros [??].
        apply H. split; auto.
        inv H2; auto.
        apply next_ranking_eliminated in Heqo.
        destruct H8. contradiction.
        intros.
        apply H in H1.
        destruct H1; split; auto.
        apply SF_spec.first_choices_not_selected; auto.
        apply next_ranking_eliminated in Heqo.
        intro. destruct H3. contradiction.
      }
      { simpl. apply SF_spec.first_choices_not_selected; auto. }
Qed.

Lemma tabulate'_first_choices_complete : forall l cd ct r,
ct <> 0 ->
SF_spec.first_choices _ (in_record r) cd l (N.to_nat ct) ->
In (cd, ct) (SF_imp.tabulate' _ _
   (fst (SF_imp.option_split (map (SF_imp.next_ranking _ _ r) l)))).
Proof.
intros.
unfold SF_imp.tabulate'.
rewrite <- (app_nil_l l) in H0.
eapply tabulate''_first_choices_complete; eauto; try solve [constructor].
split; intros.
destruct H1. inv H2. assert (cnt = 0). rewrite <- Nnat.Nat2N.inj_iff in H3.
rewrite Nnat.N2Nat.id in H3. auto. subst. congruence.
inv H1.
Qed.

Lemma tabulate_first_choices_complete : forall l cd ct r,
ct <> 0 ->
SF_spec.first_choices _ (in_record r) cd l (N.to_nat ct) ->
In (cd, ct) (fst (SF_imp.tabulate _ _ r l)).
  intros.
  unfold SF_imp.tabulate.
  destruct (SF_imp.option_split
               (map (SF_imp.next_ranking candidate reldec_candidate r) l)) eqn:?.
  eapply Permutation_in.
  apply insertion_sort_permutation.
  assert (l0 = fst (SF_imp.option_split
           (map (SF_imp.next_ranking candidate reldec_candidate r) l))).
  rewrite Heqp. auto.
  subst.
  eapply tabulate'_first_choices_complete. auto.
  auto.
Qed.

Lemma cnlt_trans : Relations_1.Transitive (boolCmpToProp (SF_imp.cnle candidate)).
Proof.
intro. intros.
destruct x, y, z.
unfold boolCmpToProp in *. simpl in *.
destruct (n <=? n0) eqn:?, (n0 <=? n1) eqn:?, (n <=? n1) eqn:?; auto.
rewrite N.leb_le in *.
rewrite N.leb_gt in *.
eapply N.le_trans in Heqb0; eauto.
rewrite N.le_ngt in *. auto.
Qed.

Lemma tabulate''_participates : forall x election n rec,
In (x, n) (SF_imp.tabulate'' _ _ (fst (SF_imp.option_split
                                        (map (SF_imp.next_ranking candidate reldec_candidate rec)
                                             election))) nil) ->
SF_spec.participates candidate x election.
Proof.
induction election; intros.
- simpl in *. inv H.
- simpl in *.
  destruct (SF_imp.next_ranking candidate reldec_candidate rec a) eqn:?.
  + destruct p.
    destruct ( SF_imp.option_split
                 (map
                    (SF_imp.next_ranking candidate reldec_candidate rec)
                    election)) eqn:?.
    simpl in *.
    destruct (rel_dec_p c x).
    * subst.
      apply next_ranking_selected in Heqo.
      eapply selected_participates. eauto.
      simpl. auto.
    * apply participates_cons. right.
      eapply IHelection. instantiate (2 := n).
      assert (fst (SF_imp.option_split
                     (map (SF_imp.next_ranking candidate reldec_candidate rec) election)) = l).
      rewrite Heqp; auto. subst.
      eapply tabulate''_same_notin. instantiate (1 := [(c,1)]).
      repeat constructor. auto. constructor.
      intro. simpl in H0. intuition. auto.
      apply H.
  + destruct (SF_imp.option_split
                     (map
                        (SF_imp.next_ranking candidate reldec_candidate rec)
                        election)) eqn:?.
    simpl in H. assert (l = (fst (SF_imp.option_split
           (map (SF_imp.next_ranking candidate reldec_candidate rec) election)))).
    rewrite Heqp. auto.
    subst.
    apply participates_cons. right.
    eapply IHelection. eauto.
Qed.

Lemma tabulate_participates : forall x n election rec,
In (x, n) (fst (SF_imp.tabulate _ _ rec election)) ->
SF_spec.participates candidate x election.
intros. unfold SF_imp.tabulate in *.
destruct (SF_imp.option_split
                  (map (SF_imp.next_ranking candidate reldec_candidate rec)
                     election)) eqn:?.
simpl in *.
assert (l = fst (SF_imp.option_split
           (map (SF_imp.next_ranking candidate reldec_candidate rec) election))).
rewrite Heqp. auto.
subst. clear Heqp.
eapply Permutation_in in H.
eapply tabulate''_participates. apply H.
symmetry. apply insertion_sort_permutation.
Qed.

Lemma get_bottom_votes_is_loser :
forall election rec losers rs election'
 (ELIMO : forall c, SF_spec.participates _ c election ->
                    SF_spec.first_choices _ (in_record rec) c election 0 ->
                    (in_record rec c)),
  SF_imp.tabulate _ _ rec election = (rs, election') ->
  SF_imp.get_bottom_votes  _ rs = losers ->
  Forall (SF_spec.is_loser candidate (in_record rec) election) losers.
Proof.
intros.
destruct (SF_imp.tabulate _ _ rec election) eqn:?. inv H.
destruct rs.
- simpl in *. auto.
- simpl in *. destruct p. rewrite N.eqb_refl.
  simpl. rewrite Forall_forall.
  intros. simpl in *.
  destruct H.
  + subst. assert (SRTD := tabulate_sorted _ _ _ _ Heqp).
    apply Sorted_StronglySorted in SRTD.
    *    assert (CRCT := tabulate_correct _ _ _ _ Heqp).
         rewrite Forall_forall in CRCT.
         specialize (CRCT (x, n)). intuition.
         simpl in *. intuition. clear H0.
         inv SRTD.
         unfold SF_spec.is_loser.
         { repeat split.
           - unfold SF_imp.tabulate in Heqp. unfold
                                           SF_imp.tabulate' in Heqp.
             destruct (SF_imp.option_split
                         (map (SF_imp.next_ranking candidate reldec_candidate rec)
                              election)) eqn:?.
             inv Heqp.
             assert (PRM := insertion_sort_permutation ((SF_imp.tabulate'' candidate reldec_candidate l []))
                                                       (SF_imp.cnle candidate)).
             eapply Permutation_sym in PRM.
             eapply Permutation_in in PRM.
             instantiate (1 := (x, n)) in PRM.
             eapply tabulate''_continuing. instantiate (1 := nil). instantiate (1 := election).
             erewrite Heqp0. simpl. eauto.
             constructor.
             rewrite H0. constructor. auto.
           - eapply tabulate_participates; eauto. instantiate (1:=rec). rewrite Heqp.
             simpl. left. reflexivity.
           - intros.
             assert (N.to_nat n = n0); [ | subst n0 ].
             { eapply SF_spec.sf_first_choices_unique in H0; [ | apply H1]. auto. }
             rewrite Forall_forall in H3.
             destruct H.
             unfold SF_spec.participates in H5.
             destruct H5.
             destruct H5. destruct H6. destruct H6.
             destruct (NPeano.Nat.eq_dec (N.to_nat n) m).
             + omega.
             + cut (In (c', (N.of_nat m)) rs).
               * intros.
                 apply H3 in H8. unfold boolCmpToProp in H8.
                 simpl in *. destruct (n <=? N.of_nat m) eqn:?; try contradiction.
                 apply N.leb_le in Heqb.
                 edestruct (rel_dec_p c' x).
                 subst.
                 eapply SF_spec.sf_first_choices_unique in H4; [ | apply H1]. intuition.
                 rewrite <- (Nnat.Nat2N.id m) in H4.
                 apply tabulate_first_choices_complete in H4.
                 rewrite Heqp in H4. simpl in H4.
                 destruct H4. congruence.
                 destruct (n <=? N.of_nat m) eqn:?; auto.
                 rewrite N.leb_le in Heqb0.
                 rewrite N.lt_eq_cases in Heqb0.
                 destruct Heqb0. rewrite Znat.N2Z.inj_lt in H9.
                 rewrite (Znat.Nat2Z.inj_le (N.to_nat n) m). rewrite Znat.N_nat_Z in *.
                 rewrite Znat.nat_N_Z in *. rewrite BinInt.Z.lt_eq_cases. auto.
                 subst. rewrite (Nnat.Nat2N.id) in *. intuition.
                 rewrite N.leb_gt in Heqb0. clear - Heqb.
                 rewrite Znat.N2Z.inj_le in Heqb.
                 rewrite Znat.nat_N_Z in *.
                 rewrite Znat.Nat2Z.inj_le.
                 rewrite Znat.N_nat_Z. auto.
                 intro. rewrite H9 in *.
                 eapply ELIMO in H4. auto.
                 unfold SF_spec.participates.
                 exists x0.
                 eauto.
               * generalize (tabulate_first_choices_complete election c' (N.of_nat m) rec).
                 rewrite Heqp. simpl.
                 rewrite Nnat.Nat2N.id.
                 intros. destruct H8; auto.
                 intro.
                 elim H.
                 apply ELIMO; auto.
                 red. eauto.
                 destruct m; auto. discriminate.
                 auto.
                 inv H8.
                 elim n0.
                 rewrite Nnat.Nat2N.id. auto.
         }
    *  apply cnlt_trans.
  + assert (In (x, n) (filter
              (fun x0 : candidate * N =>
               let (_, v') := x0 in n =? v') rs)).
    rewrite filter_In. split.
    * rewrite in_map_iff in H. destruct H. destruct x0. simpl in H. intuition.
      subst. rewrite filter_In in H1. intuition.
      apply N.eqb_eq in H0. subst.
      auto.
    * symmetry. symmetry. apply N.eqb_refl .
    * clear H.
      rewrite filter_In in H0. destruct H0.
      assert (SRTD := tabulate_sorted _ _ _ _ Heqp).
      apply Sorted_StronglySorted in SRTD.
      assert (CRCT := tabulate_correct _ _ _ _ Heqp).
      rewrite Forall_forall in CRCT.
      inv SRTD.
      simpl in *. specialize (CRCT ((x, n))).
      intuition. clear H1.
      unfold SF_spec.is_loser.
      split.
      split.
      rewrite Forall_forall in *.
      { apply nonzero_first_choices_selected in H5.
        destruct H5 as [b [??]].
        apply SF_spec.selected_candidate_not_eliminated in H2. auto.
        assert ( n = 0 \/ n > 0 ). zify. omega.
        destruct H1. subst n.
        elim (tabulate_not_0 election c rec).
        rewrite Heqp. simpl. auto.
        zify. omega.
      }
      { apply tabulate_participates with n rec.
        rewrite Heqp. simpl. auto.
      }
      intros ? ? ? [??] ? ?.
      eapply SF_spec.sf_first_choices_unique in H5; eauto. subst.
      rewrite Forall_forall in H4.
      specialize (H4 (c', (N.of_nat m))).
      destruct (rel_dec_p c c').
      subst.
      assert (CRCT := tabulate_correct _ _ _ _ Heqp).
      rewrite Forall_forall in CRCT.
      specialize (CRCT (c', n)). simpl in CRCT. intuition.
      clear H8.
      eapply SF_spec.sf_first_choices_unique in H7; eauto.
      subst.
      auto.
      assert (In (c', N.of_nat m) rs).
      rewrite <- Nnat.Nat2N.id in H7.
      apply tabulate_first_choices_complete in H7.
      rewrite Heqp in *. simpl in H7. destruct H7.
      inv H5. intuition.
      auto.
      intro.
      rewrite H5 in *. clear H5.
      apply ELIMO in H7; auto.
      intuition.
      unfold boolCmpToProp in H8. simpl in H8.
      destruct (n <=? N.of_nat m) eqn:?; intuition.
      apply N.leb_le in Heqb. zify. omega.
      apply cnlt_trans.
Qed.

Lemma last_item_in :
forall l w n,
SF_imp.last_item candidate l = Some (w,n) ->
In (w,n) l.
Proof.
induction l; intros.
simpl in *. congruence.
simpl in *. destruct l. inv H. auto.
right. auto.
Qed.

Lemma N_nat_le_inj :
forall x1 n,
x1 <= n <-> (N.to_nat x1 <= N.to_nat n)%nat.
Proof.
intros. rewrite Znat.N2Z.inj_le. rewrite Znat.Nat2Z.inj_le.
repeat rewrite Znat.N_nat_Z. intuition.
Qed.

Lemma tabulate_total_selected : forall r election election' vs,
SF_imp.tabulate _ _ r election = (vs, election') ->
SF_spec.total_selected candidate (in_record r) election (length election').
Proof.
  intros. unfold SF_imp.tabulate in *.
  destruct (SF_imp.option_split
             (map (SF_imp.next_ranking candidate reldec_candidate r) election)) eqn:?.
  simpl in *. inv H.
  generalize dependent l0.
  revert r  election l.
  induction election; intros.
  -   simpl in *. inv Heqp. constructor.
  - simpl in *. destruct (SF_imp.next_ranking candidate reldec_candidate r a) eqn:?.
    + repeat dlp.
      inv Heqp. simpl in *. apply SF_spec.total_continuing.
      apply next_ranking_selected in Heqo.
      unfold SF_spec.selected_candidate in *. intuition.
      eapply IHelection. eauto.
    + dlp. inv Heqp. simpl in *.
      apply SF_spec.total_exhausted.
      eapply next_ranking_eliminated; eauto.
      eapply IHelection; eauto.
Qed.

Lemma last_item_cons :
forall h t l,
SF_imp.last_item candidate (h :: t) = Some l ->
(t = nil /\ h = l) \/ SF_imp.last_item candidate t = Some l.
induction t; intros.
- simpl in *. inv H. auto.
- simpl in *. right.
  auto.
Qed.

Lemma ss_last :
forall l c n,
StronglySorted (boolCmpToProp (SF_imp.cnle candidate)) l ->
SF_imp.last_item candidate l = Some (c, n) ->
Forall (fun (r : candidate * N) => let (_, y) := r in y <= n) l.
Proof.
induction l; intros.
- simpl in *. congruence.
- apply last_item_cons in H0.
  rewrite Forall_forall; intros.
  intuition. subst.
  inv H1. apply N.le_refl.
  inv H0.
  destruct H1.
  + subst. destruct x.  inv H.
    rewrite Forall_forall in *.
    specialize (H4 (c, n)).
    apply last_item_in in H2. intuition.
    unfold boolCmpToProp in H.
    simpl in *.
    destruct (n0 <=? n) eqn:?; try contradiction.
    rewrite N.leb_le in Heqb. auto.
  + eapply IHl in H2; eauto.
    rewrite Forall_forall in H2.
    apply H2.  auto. inv H. auto.
Qed.

Lemma lt_of_nat :
forall n nn,
N.of_nat n < nn <->
(n < N.to_nat nn)%nat.
Proof.
intros. repeat rewrite Znat.N2Z.inj_lt.
rewrite Znat.nat_N_Z.
rewrite Znat.Nat2Z.inj_lt. rewrite Znat.N_nat_Z.
split; auto.
Qed.

Lemma gt_of_nat :
forall n nn,
N.of_nat n > nn <->
(n > N.to_nat nn)%nat.
Proof.
intros. repeat rewrite Znat.N2Z.inj_gt.
rewrite Znat.nat_N_Z.
rewrite Znat.Nat2Z.inj_gt. rewrite Znat.N_nat_Z.
split; auto.
Qed.

Lemma gt_of_nat2 :
forall n nn,
 n > N.of_nat nn <->
(N.to_nat n >  nn)%nat.
Proof.
intros. repeat rewrite Znat.N2Z.inj_gt.
rewrite Znat.nat_N_Z.
rewrite Znat.Nat2Z.inj_gt. rewrite Znat.N_nat_Z.
split; auto.
Qed.

Lemma NNatex :
forall x0,
exists nx0, N.to_nat nx0 = x0.
intros. induction x0. exists 0. auto.
destruct IHx0. exists (N.succ x).
rewrite Nnat.N2Nat.inj_succ. auto.
Qed.

Lemma run_election'_correct :
  forall fuel election winner rec' rec tbreak res
         (TB : forall c x, tbreak c = Some x -> In x c)
         (N0 : forall c, SF_spec.participates _ c election ->
                           SF_spec.first_choices _ (in_record rec) c election 0 ->
                           in_record rec c),
    SF_imp.run_election' candidate _ tbreak election rec fuel = (Some winner, rec', res) ->
    SF_spec.winner candidate election (in_record rec) winner.
induction fuel; intros.
- simpl in *. congruence.
- simpl in *. destruct (SF_imp.tabulate candidate reldec_candidate rec election) eqn:?;
                       simpl in *; try congruence.
  destruct (SF_imp.last_item candidate l) eqn:?; try congruence.
  destruct p.
  destruct ( SF_imp.gtb_N (n * 2) (N.of_nat (length e))) eqn:?.
  + inv H.
    apply SF_spec.winner_now. unfold SF_spec.majority.
    intros. assert (winner_votes = (N.to_nat n)).
    { apply tabulate_correct in Heqp.
      rewrite Forall_forall in Heqp. specialize (Heqp (winner, n)).
      apply last_item_in in Heqo. intuition.
      eapply SF_spec.sf_first_choices_unique in H1; eauto. }
    subst.
    assert (total_votes = (length e)).
    { apply tabulate_total_selected in Heqp.
      eapply SF_spec.total_selected_unique; eauto. }
    subst.
    rewrite SF_imp.gtb_nat_gt in Heqb. rewrite gt_of_nat2 in Heqb.
    rewrite Nnat.N2Nat.inj_mul in Heqb. auto.
    apply _.
  + unfold SF_imp.find_eliminated_noopt in *.
    destruct (tbreak (SF_imp.get_bottom_votes candidate l)) eqn:?.
    * rename c0 into loser.
      rename Heqo0 into TBREAK.
      copy Heqp. rename H0 into ISLOSER.
      eapply get_bottom_votes_is_loser in ISLOSER; eauto.
      rewrite Forall_forall in ISLOSER.
      eapply TB in TBREAK.
      apply ISLOSER in TBREAK.
      { eapply SF_spec.winner_elimination.
        - unfold SF_spec.no_majority.
          intro. destruct H0.
          assert (~ SF_spec.majority _ (in_record rec) election c).
          { intro.
            unfold SF_spec.majority in *.
            specialize (H1 (length e) (N.to_nat n)).
            copy Heqp.
            apply tabulate_total_selected in H2. intuition.
            apply tabulate_correct in Heqp.
            rewrite Forall_forall in Heqp.
            specialize (Heqp (c, n)). simpl in *.
            apply last_item_in in Heqo. intuition.
            change 2%nat with (N.to_nat 2) in H4.
            rewrite <- Nnat.N2Nat.inj_mul in H4.
            rewrite <- gt_of_nat2 in H4.
            rewrite <- SF_imp.gtb_nat_gt in H4. congruence.
            apply _.
          }
          copy Heqp.
          apply tabulate_sorted in Heqp.
          clear - Heqp Heqo H0 H1 H2 N0.
          destruct (majority_not_0 _ _ _ _ H0). intuition.
          rename H4 into X0. rename H3 into FCX.
          apply Sorted_StronglySorted in Heqp; [ |  apply cnlt_trans].
          eapply ss_last in Heqp; eauto.
          rewrite Forall_forall in *.
          apply H1. clear H1. intro; intros.
          assert (winner_votes = (N.to_nat n)).
          { apply last_item_in in Heqo.
            apply tabulate_correct in H2.
            rewrite Forall_forall in H2. eapply H2 in Heqo; clear H2.
            eapply SF_spec.sf_first_choices_unique; eauto. }
          subst.
          unfold SF_spec.majority in H0.
          copy FCX.
          destruct (NNatex x0).
          rewrite <- H4 in H3.
          apply tabulate_first_choices_complete in H3; auto.
          rewrite H2 in *. simpl in *.
          specialize (Heqp (x, x1)).
          intuition.
          eapply H0 in FCX; eauto. subst. rewrite  N_nat_le_inj in H5. omega.
          subst. intro. subst. intuition.
        - eauto.
        - rewrite update_eliminated_in_rec_eq_noc.
          destruct (SF_imp.run_election' candidate reldec_candidate tbreak election
                                         ([loser] :: rec) fuel) eqn:REQN. destruct p.
          eapply IHfuel.
          + eauto.
          + intros. edestruct (rel_dec_p c0 loser).
            * subst. unfold in_record. exists [loser].
              intuition.
            * apply N0 in H0. unfold in_record in *.
              destruct H0.
              exists x. intuition.
              eapply first_choices_rec_0; eauto.
          + inv H. rewrite REQN.  auto.
      }
    * congruence.
Qed.

Lemma no_dup_map_allc :  forall allc,
NoDup allc ->
NoDup (fst (split (map (fun x : candidate => (x, 0)) allc))).
Proof.
induction allc; intros.
- simpl. auto.
- simpl. inv H.
  destruct ( split (map (fun x : candidate => (x, 0)) allc) ) eqn:?.
  assert (l = fst (split (map (fun x : candidate => (x, 0)) allc))).
  rewrite Heqp. auto. subst.
  simpl in *. constructor; auto. intuition.   clear - H2 H reldec_correct_candidate.
  apply H2. apply in_split in H. intuition_nosplit.
  apply in_map_iff in H. destruct H. intuition. inv H0. auto.
Qed.

Lemma nodup_not_in_filter :
forall allc c l,
NoDup allc ->
~ In c
         (map (@fst _ _)
            (filter
               (fun x : candidate * N =>
                let (_, ct) := x in  ct =? 0)
               (SF_imp.tabulate'' candidate reldec_candidate l
                  (SF_imp.increment candidate reldec_candidate
                     (map (fun x : candidate => (x, 0)) allc) c)))).
Proof.
intros. intro.
apply in_map_iff in H0. destruct H0. destruct H0. destruct x. simpl in *. subst.
apply filter_In in H1. destruct H1. rewrite N.eqb_eq in H1.
subst. edestruct increment_same_s. Focus 2.
 eapply tabulate''_not_0. Focus 2. eauto. apply increment_nodup.
instantiate (1:=map (fun x : candidate => (x, 0)) allc). apply no_dup_map_allc; auto.
rewrite N.add_1_r. apply N.succ_0_discr.
eauto. apply no_dup_map_allc. auto.
Qed.

Lemma tabulate_0_running :
forall (c: candidate) l running
(NODUP: NoDup (fst (split (running)))),
In (c, 0) (SF_imp.tabulate'' _ _ l running) ->
In (c, 0) running.
Proof.
induction l.
- intros. simpl in *. auto.
- intros. simpl in *. destruct a.
  destruct (rel_dec_p c c0).
  + subst. exfalso.
    edestruct (increment_same_s c0).
    eauto.
    eapply tabulate''_not_0.
    * apply increment_nodup. eauto.
    * apply H0.
    * rewrite N.add_1_r. apply N.succ_0_discr.
    * eauto.
  + apply IHl in H.
    eapply increment_neq' in H; auto.
    apply increment_nodup. auto.
  + apply IHl in H; auto.
Qed.

Lemma find_0s_correct :
forall allc election c
(PART: forall c, SF_spec.participates _ c election -> In c allc),
NoDup allc ->
In c (SF_imp.find_0s candidate reldec_candidate allc election) ->
SF_spec.first_choices _ (in_record nil) c election 0.
Proof.
intros.
induction election; intros.
- constructor.
- unfold SF_imp.find_0s in *. simpl in *.
  destruct (SF_imp.next_ranking candidate reldec_candidate [] a) eqn:?.
  + destruct p. destruct (SF_imp.option_split
                            (map (SF_imp.next_ranking candidate reldec_candidate [])
                                 election)) eqn:?.
    simpl in *. destruct (rel_dec_p c0 c).
    * subst.
      eapply nodup_not_in_filter in H. exfalso. apply H. apply H0.
    * apply SF_spec.first_choices_not_selected.
      intro. apply next_ranking_selected in Heqo.
      eapply SF_spec.selected_candidate_unique in Heqo; eauto.
      apply IHelection; eauto. intros. apply PART.
      apply participates_cons. auto.
      apply in_map_iff.
      apply in_map_iff in H0. intuition_nosplit.
      exists x. destruct x. simpl in H0. subst. intuition.
      apply filter_In in H1. apply filter_In. intuition.
      { destruct (classic (In (c, n0)
                            (SF_imp.tabulate'' candidate reldec_candidate l
                                               (map (fun x : candidate => (x, 0)) allc)))).
        - eapply tabulate''_same; [ | | | | exact H0]. apply increment_nodup.
          + apply no_dup_map_allc. auto.
          + apply no_dup_map_allc. auto.
          + apply increment_neq; eauto.
            specialize (PART c). apply in_map_iff. exists c. split.
            * reflexivity.
            * rewrite N.eqb_eq in H2. subst.
              apply tabulate_0_running in H1. apply in_map_iff in H1.
              destruct H1. destruct H1. inv H1. auto. apply no_dup_map_allc. auto.
          + rewrite N.eqb_eq in H2. subst.
            eapply tabulate_0_running. apply no_dup_map_allc; auto.
            eauto.
        - eapply tabulate''_same in H0.
          + exfalso. apply H1. apply H0.
          + apply increment_nodup; auto.
            apply no_dup_map_allc; auto.
          + apply no_dup_map_allc; auto.
          + eapply increment_neq; auto.
            apply in_map_iff. exists c.
            intuition. apply N.eqb_eq in H2. subst.
            apply tabulate_0_running in H0. eapply increment_neq' in H0; auto.
            apply in_map_iff in H0; intuition_nosplit; auto.
            apply increment_nodup. apply no_dup_map_allc. auto.
          + apply in_map_iff. exists c. intuition. apply N.eqb_eq in H2. subst.
            apply tabulate_0_running in H0. eapply increment_neq' in H0; auto.
            apply in_map_iff in H0; intuition_nosplit; auto.
            apply increment_nodup. apply no_dup_map_allc. auto.
      }
  + destruct (SF_imp.option_split
                    (map (SF_imp.next_ranking candidate reldec_candidate [])
                       election)) eqn:?.
    simpl in *.
    apply IHelection in H0; auto.
    * constructor. intro. unfold SF_spec.selected_candidate in H1.
      intuition_nosplit. apply next_ranking_eliminated in Heqo.
      unfold SF_spec.continuing_ballot in *. intuition.
      auto.
    * intros. apply PART. apply participates_cons; auto.
Qed.

Lemma selected_not_in' :
forall  ef l cd r l0,
SF_imp.option_split
           (map (SF_imp.next_ranking candidate reldec_candidate r) ef) =
         (l, l0) ->
SF_spec.first_choices candidate (in_record r) cd ef 0 ->
~(In (Some cd ) l).
Proof.
induction ef; intros.
- simpl in *. inv H0. inv H.
  simpl. auto.
- simpl in *.
  destruct (SF_imp.next_ranking candidate reldec_candidate r a) eqn:?.
  + destruct p. destruct (SF_imp.option_split
                            (map (SF_imp.next_ranking candidate reldec_candidate r) ef)) eqn:?.
    simpl in *. inv H.
    inv H0. simpl in *.
    intuition.
    inv H0.
    apply next_ranking_selected in Heqo.
    contradiction.
    subst; auto.
    eapply IHef; eauto.
  + destruct (SF_imp.option_split
              (map (SF_imp.next_ranking candidate reldec_candidate r) ef)) eqn:?.
    inv H.
    inv H0.
    simpl in *.
    intuition.
    discriminate.
    eapply IHef; eauto.
Qed.

Lemma find_0s_complete :
  forall election allc c
    (PART: forall c, SF_spec.participates _ c election -> In c allc)
    (NODUP:NoDup allc),
    SF_spec.first_choices candidate (in_record []) c election 0 ->
    True ->
    In c allc ->
    In c (SF_imp.find_0s candidate reldec_candidate allc election).
Proof.
  induction election; simpl; intros.
  inv H.
  { unfold SF_imp.find_0s in *; simpl.
    rewrite in_map_iff.
    exists (c,0).
    split; simpl; auto.
    rewrite filter_In. split. 2: rewrite N.eqb_eq; auto.
    apply in_map_iff. exists c. split; auto.
  }
  inv H.
  unfold SF_imp.find_0s in *.
  simpl in *.
  destruct (SF_imp.next_ranking candidate reldec_candidate [] a) eqn:?.
  + simpl.
    destruct p. destruct (SF_imp.option_split
                            (map (SF_imp.next_ranking candidate reldec_candidate [])
                                 election)) eqn:?.
    destruct (rel_dec_p c0 c).
    apply next_ranking_selected in Heqo.
    subst c0. contradiction.
    apply in_map_iff. exists (c, 0). split; simpl; auto.
    apply filter_In. split. 2: rewrite N.eqb_eq; auto.
    apply tabulate_not_in_l.
    apply increment_nodup.
    rewrite <- split_fst.
    rewrite map_map. simpl.
    rewrite map_id. auto.
    apply increment_neq; auto.
    apply in_map_iff.
    exists c. split; auto.
    intro.
    eapply selected_not_in'; eauto.

  + simpl in *.
    destruct (SF_imp.option_split
                    (map (SF_imp.next_ranking candidate reldec_candidate [])
                       election)) eqn:?.
    simpl.
    apply IHelection; auto.
    intros. apply PART. apply participates_cons; auto.
Qed.

Lemma find_0s_nodup :
  forall allc e,
    NoDup allc ->
    NoDup (SF_imp.find_0s candidate reldec_candidate allc e).
Proof.
  intros.
  unfold SF_imp.find_0s.
  case_eq (SF_imp.option_split
            (map (SF_imp.next_ranking candidate reldec_candidate []) e)).
  intros a b Hab.
  rewrite split_fst.
  assert (NoDup (fst (split (map (fun x : candidate => (x, 0)) allc)))).
  { replace (fst (split (map (fun x : candidate => (x, 0)) allc))) with allc; auto.
    clear. induction allc; simpl; auto.
    destruct (split (map (fun x => (x,0)) allc)); simpl in *.
    f_equal; auto.
  }
  generalize (tabulate_nodup a (map (fun x => (x,0)) allc) H0).
  generalize (SF_imp.tabulate'' candidate reldec_candidate a
              (map (fun x : candidate => (x, 0)) allc)).
  generalize (fun x : candidate * N => let (_, ct) := x in ct =? 0).
  intro f. induction l; simpl; intros; auto.
  destruct a0; simpl in *.
  case_eq (split l); intros.
  rewrite H2 in H1.
  rewrite H2 in IHl.
  simpl in *.
  inv H1.
  case_eq (f (c,n)); intros.
  simpl.
  case_eq (split (filter f l)); simpl; intros.
  constructor; auto.
  { intro. apply H5.
    clear -H3 H2 H4.
    revert l0 l1 l2 l3 H2 H3 H4.
    induction l; simpl; intros; auto.
    inv H2. inv H3. auto.
    destruct a; simpl in *.
    case_eq (split l); intros.
    rewrite H in H2.
    inv H2.
    case_eq (split (filter f l)); intros.
    generalize (IHl l4 l5 l0 l1 H H0); intros.
    destruct (f (c0,n)). simpl in *.
    rewrite H0 in H3.
    inv H3.
    simpl in H4; intuition.
    rewrite H3 in H0.
    inv H0.
    simpl; intuition.
  }
  rewrite H3 in IHl.
  simpl in IHl.
  apply IHl; auto.
  apply IHl; auto.
Qed.

Lemma find_0s_subset :
  forall allc l e,
    NoDup allc ->
    In l (SF_imp.find_0s candidate reldec_candidate allc e) ->
    In l allc.
Proof.
  intros.
  unfold SF_imp.find_0s in H0.
  cut (In (l,0) (map (fun x => (x,0)) allc)).
  { clear. induction allc; simpl; intuition.
    inv H0. auto.
  }
  destruct (SF_imp.option_split
                (map (SF_imp.next_ranking candidate reldec_candidate []) e)).
  eapply tabulate_0_running.
  { replace (fst (split (map (fun x : candidate => (x, 0)) allc))) with allc; auto.
    clear.
    rewrite <- split_fst.
    rewrite map_map.
    simpl.
    symmetry. apply map_id.
  }
  rewrite in_map_iff in H0.
  destruct H0 as [x [??]].
  destruct x. simpl in *.
  subst c.
  rewrite filter_In in H1. destruct H1.
  rewrite N.eqb_eq in H1. subst n.
  apply H0.
Qed.

Lemma count_votes_nonzero :
  forall P e n,
    (n > 0)%nat->
    Ranked_properties.count_votes candidate P e n ->
    exists b, In b e /\ P b.
Proof.
  induction e; intros.
  * inv H0. omega.
  * inv H0.
    exists a. split; simpl; auto.
    destruct (IHe n) as [b [??]]; auto.
    exists b; split; simpl; auto.
Qed.

Lemma count_votes_find_0s :
  forall allc election
  (NODUP : NoDup allc)
  (PART : forall c, SF_spec.participates _ c election -> In c allc) ,
   Ranked_properties.count_votes candidate
     (fun b : list (list candidate) =>
      exists c : candidate,
        SF_spec.selected_candidate candidate (in_record []) b c /\
        In c (SF_imp.find_0s candidate reldec_candidate allc election))
     election 0.
Proof.
  intros.
  destruct (count_votes_total _ (fun b : list (list candidate) =>
      exists c : candidate,
        SF_spec.selected_candidate candidate (in_record []) b c /\
        In c (SF_imp.find_0s candidate reldec_candidate allc election))
     election) as [n ?].
  destruct n; auto.
  elimtype False.
  assert (exists b, In b election /\
      exists c : candidate,
        SF_spec.selected_candidate candidate (in_record []) b c /\
        In c (SF_imp.find_0s candidate reldec_candidate allc election)).
  { apply count_votes_nonzero in H. auto. omega. }
  destruct H0 as [b [? [c [??]]]].
  assert (SF_spec.first_choices candidate (in_record []) c election 0).
  apply (find_0s_correct allc election c); auto.
  clear -H1 H0 H3.
  induction election.
  * elim H0.
  * apply first_choices_0_cons in H3. destruct H3.
    hnf in H0. destruct H0; auto.
    subst a.
    inv H.
    contradiction.
Qed.

Lemma winner_viable :
  forall elim election c,
    SF_spec.winner candidate election elim c ->
    SF_spec.viable_candidate candidate elim election c.
Proof.
  intros. induction H.
  destruct (majority_not_0 _ eliminated election winning_candidate) as [v [??]]; auto.
  destruct (nonzero_first_choices_selected _ eliminated winning_candidate election v) as [b [??]]; auto.
  omega.
  split.
  eapply SF_spec.selected_candidate_not_eliminated; eauto.
  eapply selected_participates; eauto.
  destruct IHwinner; split; auto.
  intro. apply H2.
  hnf. auto.
Qed.

Theorem run_election_correct : forall election winner tb rec allc res
  (TB : forall c x, tb c = Some x -> In x c)
  (PART : forall c, SF_spec.participates _ c election -> In c allc)
  (NODUP : NoDup allc),
    SF_imp.run_election candidate _ tb election allc = (Some winner, rec, res) ->
    SF_spec.winner _ election (in_record []) winner.
Proof.
intros. unfold SF_imp.run_election in H.
apply run_election'_correct in H; auto.
- rewrite -> sf_spec_optimization with
     (SF_imp.find_0s _ reldec_candidate allc election) 0%nat; auto. apply H.
  + apply count_votes_find_0s; auto.
  + exists winner.
    apply winner_viable in H.
    destruct H; split; auto.
    intro.
    apply H.
    hnf. eexists.
    split. simpl; auto. auto.
    split; auto.
    intros [q [??]]. elim H1.
  + intros. destruct count; auto with arith.
    elim H0. clear H0.
    apply find_0s_complete; auto.
    intros. apply PART; auto.
    destruct H1; auto.
  + unfold in_record. firstorder. subst x0. auto.
- intros.
  eexists. simpl. split. left. reflexivity.
  apply find_0s_complete; auto.
  destruct (SF_spec.sf_first_choices_total _ (in_record []) election c).
  destruct x; auto.
  cut (S x <= 0)%nat. omega.
  eapply first_choices_monotone.
  2: eauto. 2: eauto.
  intro.
  hnf in H3.
  destruct H3 as [q [??]].
  hnf in H3. destruct H3. 2: elim H3.
  subst q.
  assert (SF_spec.first_choices _ (in_record []) c election 0).
  apply (find_0s_correct allc election c); auto.
  assert( 0 = S x)%nat.
  eapply SF_spec.sf_first_choices_unique; eauto.
  inv H5.
  intros.
  hnf in H3.
  destruct H3 as [q[??]].
  elim H3.
Qed.

End cand.

Check run_election_correct.
Print Assumptions run_election_correct.