(* ========================================================================= *)
(* Ballot problem.                                                           *)
(* ========================================================================= *)

needs "Library/binomial.ml";;

prioritize_num();;

(* ------------------------------------------------------------------------- *)
(* Restricted function space.                                                *)
(* ------------------------------------------------------------------------- *)

parse_as_infix("-->",(13,"right"));;

let funspace = new_definition
 `(s --> t) = {f:A->B | (!x. x IN s ==> f(x) IN t) /\
                        (!x. ~(x IN s) ==> f(x) = @y. T)}`;;
let FUNSPACE_EMPTY = 
prove (`({} --> t) = {(\x. @y. T)}`,
REWRITE_TAC[EXTENSION; IN_SING; funspace; IN_ELIM_THM; NOT_IN_EMPTY] THEN REWRITE_TAC[FUN_EQ_THM]);;
let HAS_SIZE_FUNSPACE = 
prove (`!s:A->bool t:B->bool m n. s HAS_SIZE m /\ t HAS_SIZE n ==> (s --> t) HAS_SIZE (n EXP m)`,
REWRITE_TAC[HAS_SIZE; GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL [SIMP_TAC[CARD_CLAUSES; FINITE_RULES; FUNSPACE_EMPTY; NOT_IN_EMPTY] THEN REPEAT GEN_TAC THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[EXP; ARITH]; ALL_TAC] THEN REWRITE_TAC[GSYM HAS_SIZE] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `(x INSERT s) --> t = IMAGE (\(y:B,g) u:A. if u = x then y else g(u)) {y,g | y IN t /\ g IN s --> t}` SUBST1_TAC THENL [REWRITE_TAC[EXTENSION; IN_IMAGE; funspace; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[TAUT `(a /\ b /\ c) /\ d <=> d /\ a /\ b /\ c`] THEN REWRITE_TAC[PAIR_EQ; EXISTS_PAIR_THM; GSYM CONJ_ASSOC] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN X_GEN_TAC `f:A->B` THEN EQ_TAC THENL [STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`(f:A->B) x`; `\u. if u = x then @y. T else (f:A->B) u`] THEN REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[IN_INSERT]; REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`y:B`; `g:A->B`] THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_MESON_TAC[IN_INSERT]]; ALL_TAC] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN CONJ_TAC THENL [REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_THM] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ d <=> d /\ a /\ b`] THEN REWRITE_TAC[PAIR_EQ; EXISTS_PAIR_THM; GSYM CONJ_ASSOC] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN REWRITE_TAC[FUN_EQ_THM; funspace; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[IN_INSERT]; ALL_TAC] THEN X_GEN_TAC `u:A` THEN ASM_CASES_TAC `u:A = x` THEN ASM_MESON_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN ASM_SIMP_TAC[CARD_CLAUSES; EXP] THEN MATCH_MP_TAC HAS_SIZE_PRODUCT THEN ASM_MESON_TAC[]);;
let FINITE_FUNSPACE = 
prove (`!s t. FINITE s /\ FINITE t ==> FINITE(s --> t)`,
MESON_TAC[HAS_SIZE_FUNSPACE; HAS_SIZE]);;
(* ------------------------------------------------------------------------- *) (* Definition of the problem. *) (* ------------------------------------------------------------------------- *)
let vote_INDUCT,vote_RECURSION = define_type
 "vote = A | B";
;
let all_countings = new_definition
 `all_countings a b =
        let n = a + b in
        CARD {f | f IN (1..n --> {A,B}) /\
                  CARD { i | i IN 1..n /\ f(i) = A} = a /\
                  CARD { i | i IN 1..n /\ f(i) = B} = b}`;;
let valid_countings = new_definition
 `valid_countings a b =
        let n = a + b in
        CARD {f | f IN (1..n --> {A,B}) /\
                  CARD { i | i IN 1..n /\ f(i) = A} = a /\
                  CARD { i | i IN 1..n /\ f(i) = B} = b /\
                  !m. 1 <= m /\ m <= n
                      ==> CARD { i | i IN 1..m /\ f(i) = A} >
                          CARD { i | i IN 1..m /\ f(i) = B}}`;;
(* ------------------------------------------------------------------------- *) (* Various lemmas. *) (* ------------------------------------------------------------------------- *) let vote_CASES = cases "vote" and vote_DISTINCT = distinctness "vote";;
let FINITE_COUNTINGS = 
prove (`FINITE {f | f IN (1..n --> {A,B}) /\ P f}`,
MATCH_MP_TAC FINITE_RESTRICT THEN MATCH_MP_TAC FINITE_FUNSPACE THEN REWRITE_TAC[FINITE_NUMSEG; FINITE_INSERT; FINITE_RULES]);;
let UNIV_VOTE = 
prove (`(:vote) = {A,B}`,
REWRITE_TAC[EXTENSION; IN_UNIV; IN_INSERT; NOT_IN_EMPTY; vote_CASES]);;
let ADD1_NOT_IN_NUMSEG = 
prove (`!m n. ~((n + 1) IN m..n)`,
REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC);;
let NUMSEG_1_CLAUSES = 
prove (`!n. 1..(n+1) = (n + 1) INSERT (1..n)`,
REWRITE_TAC[GSYM ADD1; NUMSEG_CLAUSES; ARITH_RULE `1 <= SUC n`]);;
let NUMSEG_RESTRICT_SUC = 
prove (`{i | i IN 1..(n+1) /\ P i} = if P(n + 1) then (n + 1) INSERT {i | i IN 1..n /\ P i} else {i | i IN 1..n /\ P i}`,
REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM; NUMSEG_1_CLAUSES; IN_INSERT] THEN ASM_MESON_TAC[ADD1_NOT_IN_NUMSEG]);;
let CARD_NUMSEG_RESTRICT_SUC = 
prove (`CARD {i | i IN 1..(n+1) /\ P i} = if P(n + 1) then CARD {i | i IN 1..n /\ P i} + 1 else CARD {i | i IN 1..n /\ P i}`,
REPEAT GEN_TAC THEN REWRITE_TAC[NUMSEG_RESTRICT_SUC] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[CARD_CLAUSES; FINITE_RESTRICT; FINITE_NUMSEG] THEN REWRITE_TAC[IN_ELIM_THM; ADD1_NOT_IN_NUMSEG; ADD1]);;
let FORALL_RANGE_SUC = 
prove (`(!i. 1 <= i /\ i <= n + 1 ==> P i) <=> P(n + 1) /\ (!i. 1 <= i /\ i <= n ==> P i)`,
REWRITE_TAC[ARITH_RULE `i <= n + 1 <=> i <= n \/ i = n + 1`] THEN MESON_TAC[ARITH_RULE `1 <= n + 1`]);;
let IN_NUMSEG_RESTRICT_FALSE = 
prove (`m <= n ==> (i IN 1..m /\ (if i = n + 1 then p i else q i) <=> i IN 1..m /\ q i)`,
REWRITE_TAC[IN_NUMSEG] THEN MESON_TAC[ARITH_RULE `i <= m /\ m <= n ==> ~(i = n + 1)`]);;
let CARD_NUMSEG_RESTRICT_EXTREMA = 
prove (`(CARD {i | i IN 1..n /\ P i} = n <=> !i. 1 <= i /\ i <= n ==> P i) /\ (CARD {i | i IN 1..n /\ P i} = 0 <=> !i. 1 <= i /\ i <= n ==> ~(P i))`,
SIMP_TAC[CARD_EQ_0; FINITE_RESTRICT; FINITE_NUMSEG] THEN MP_TAC(ISPECL [`{i | i IN 1..n /\ P i}`; `1..n`] SUBSET_CARD_EQ) THEN SIMP_TAC[FINITE_NUMSEG; SUBSET; IN_ELIM_THM; CARD_NUMSEG_1] THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_NUMSEG; IN_ELIM_THM] THEN MESON_TAC[]);;
let VOTE_NOT_EQ = 
prove (`(!x. ~(x = A) <=> x = B) /\ (!x. ~(x = B) <=> x = A)`,
MESON_TAC[vote_CASES; vote_DISTINCT]);;
let FUNSPACE_FIXED = 
prove (`{f | f IN (s --> t) /\ (!i. i IN s ==> f i = a)} = if s = {} \/ a IN t then {(\i. if i IN s then a else @x. T)} else {}`,
REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM; funspace; NOT_IN_EMPTY; IN_SING] THEN REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]);;
let COUNTING_LEMMA = 
prove (`CARD {f | f IN (1..(n+1) --> {A,B}) /\ P f} = CARD {f | f IN (1..n --> {A,B}) /\ P (\i. if i = n + 1 then A else f i)} + CARD {f | f IN (1..n --> {A,B}) /\ P (\i. if i = n + 1 then B else f i)}`,
MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `CARD {f | f IN (1..(n+1) --> {A,B}) /\ f(n+1) = A /\ P f} + CARD {f | f IN (1..(n+1) --> {A,B}) /\ f(n+1) = B /\ P f}` THEN CONJ_TAC THENL [CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_UNION_EQ THEN REWRITE_TAC[FINITE_COUNTINGS; EXTENSION; IN_INTER; IN_UNION] THEN REWRITE_TAC[IN_ELIM_THM; NOT_IN_EMPTY] THEN MESON_TAC[vote_CASES; vote_DISTINCT]; ALL_TAC] THEN BINOP_TAC THEN MATCH_MP_TAC BIJECTIONS_CARD_EQ THEN EXISTS_TAC `\f i. if i = n + 1 then @x:vote. T else f i` THENL [EXISTS_TAC `\f i. if i = n + 1 then A else f i`; EXISTS_TAC `\f i. if i = n + 1 then B else f i`] THEN REWRITE_TAC[FINITE_COUNTINGS] THEN REWRITE_TAC[IN_ELIM_THM; funspace; GSYM UNIV_VOTE; IN_UNIV] THEN REWRITE_TAC[NUMSEG_1_CLAUSES; IN_INSERT] THEN REPEAT STRIP_TAC THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] `P x ==> x = y ==> P y`))) THEN TRY(GEN_REWRITE_TAC I [FUN_EQ_THM]) THEN ASM_MESON_TAC[ADD1_NOT_IN_NUMSEG]);;
(* ------------------------------------------------------------------------- *) (* Recurrence relations. *) (* ------------------------------------------------------------------------- *)
let ALL_COUNTINGS_0 = 
prove (`!a. all_countings a 0 = 1 /\ all_countings 0 a = 1`,
let VALID_COUNTINGS_0 = 
prove (`valid_countings 0 0 = 1 /\ !a. valid_countings (SUC a) 0 = 1 /\ valid_countings 0 (SUC a) = 0`,
let lemma = prove
   (`{x} INTER s = if x IN s then {x} else {}`,
    COND_CASES_TAC THEN ASM SET_TAC[]) in
  REWRITE_TAC[valid_countings; CARD_NUMSEG_RESTRICT_EXTREMA; GSYM IN_NUMSEG;
              LET_DEF; LET_END_DEF; ADD_CLAUSES; VOTE_NOT_EQ;
              TAUT `a /\ a /\ b <=> a /\ b`] THEN
  REWRITE_TAC[CONJUNCT1 NUMSEG_CLAUSES; ARITH_EQ; NOT_IN_EMPTY] THEN
  CONJ_TAC THENL
   [REWRITE_TAC[funspace; IN_ELIM_THM; NOT_IN_EMPTY; GSYM FUN_EQ_THM] THEN
    REWRITE_TAC[SET_RULE `{x | x = a} = {a}`] THEN
    SIMP_TAC[CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; ARITH];
    ALL_TAC] THEN
  ONCE_REWRITE_TAC[SET_RULE `{x | P x /\ Q x /\ R x} =
                             {x | P x /\ Q x} INTER {x | R x}`] THEN
  REWRITE_TAC[FUNSPACE_FIXED; IN_INSERT; lemma] THEN
  REWRITE_TAC[IN_ELIM_THM] THEN
  GEN_TAC THEN CONJ_TAC THEN COND_CASES_TAC THEN
  ASM_SIMP_TAC[CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; ARITH] THEN
  POP_ASSUM MP_TAC THEN REWRITE_TAC[NOT_FORALL_THM] THENL
   [X_GEN_TAC `k:num` THEN DISCH_TAC THEN
    MATCH_MP_TAC(ARITH_RULE `b = 0 /\ ~(a = 0) ==> a > b`) THEN
    ASM_SIMP_TAC[CARD_NUMSEG_RESTRICT_EXTREMA] THEN
    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_NUMSEG]) THEN
    DISCH_THEN(ASSUME_TAC o MATCH_MP (ARITH_RULE
     `1 <= k /\ k <= a ==> 1 <= k /\ !i. i <= k ==> i <= a`)) THEN
    ASM_SIMP_TAC[IN_NUMSEG; vote_DISTINCT] THEN
    DISCH_THEN(MP_TAC o SPEC `1`) THEN POP_ASSUM MP_TAC THEN ARITH_TAC;
    EXISTS_TAC `1` THEN REWRITE_TAC[NUMSEG_SING; IN_SING] THEN
    REWRITE_TAC[IN_NUMSEG; LE_REFL; ARITH_RULE `1 <= SUC n`] THEN
    MATCH_MP_TAC(ARITH_RULE `b = 0 /\ ~(a = 0) ==> ~(b > a)`) THEN
    ONCE_REWRITE_TAC[SET_RULE `{x | x = a /\ P x} = {x | x = a /\ P a}`] THEN
    REWRITE_TAC[IN_NUMSEG; LE_REFL; ARITH_RULE `1 <= SUC n`] THEN
    SIMP_TAC[vote_DISTINCT; SET_RULE `{x | F} = {} /\ {x | x = a} = {a}`;
             CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; ARITH]]);;
let ALL_COUNTINGS_SUC = 
prove (`!a b. all_countings (a + 1) (b + 1) = all_countings a (b + 1) + all_countings (a + 1) b`,
REPEAT GEN_TAC THEN REWRITE_TAC[all_countings] THEN SUBST1_TAC(ARITH_RULE `(a + 1) + (b + 1) = (a + b + 1) + 1`) THEN SUBST1_TAC(ARITH_RULE `(a + 1) + b = a + b + 1`) THEN ABBREV_TAC `n = a + b + 1` THEN CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN GEN_REWRITE_TAC LAND_CONV [COUNTING_LEMMA] THEN REWRITE_TAC[] THEN BINOP_TAC THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN REWRITE_TAC[vote_DISTINCT] THEN REWRITE_TAC[CARD_NUMSEG_RESTRICT_SUC] THEN SIMP_TAC[IN_NUMSEG_RESTRICT_FALSE; LE_REFL; EQ_ADD_RCANCEL]);;
let VALID_COUNTINGS_SUC = 
prove (`!a b. valid_countings (a + 1) (b + 1) = if a <= b then 0 else valid_countings a (b + 1) + valid_countings (a + 1) b`,
REPEAT STRIP_TAC THEN ASM_CASES_TAC `b:num < a` THEN ASM_REWRITE_TAC[GSYM NOT_LT] THEN REWRITE_TAC[valid_countings] THEN SUBST1_TAC(ARITH_RULE `(a + 1) + (b + 1) = (a + b + 1) + 1`) THEN SUBST1_TAC(ARITH_RULE `(a + 1) + b = a + b + 1`) THEN ABBREV_TAC `n = a + b + 1` THEN CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN GEN_REWRITE_TAC LAND_CONV [COUNTING_LEMMA] THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN REWRITE_TAC[vote_DISTINCT] THEN REWRITE_TAC[FORALL_RANGE_SUC] THEN REWRITE_TAC[CARD_NUMSEG_RESTRICT_SUC] THEN SIMP_TAC[IN_NUMSEG_RESTRICT_FALSE; LE_REFL; EQ_ADD_RCANCEL] THEN SIMP_TAC[MESON[] `x = a /\ y = b /\ P x y <=> x = a /\ y = b /\ P a b`] THEN ASM_REWRITE_TAC[GT; LT_ADD_RCANCEL] THEN REWRITE_TAC[SET_RULE `{x | F} = EMPTY`; CARD_CLAUSES; ADD_CLAUSES]);;
(* ------------------------------------------------------------------------- *) (* Main result. *) (* ------------------------------------------------------------------------- *)
let ALL_COUNTINGS = 
prove (`!a b. all_countings a b = binom(a + b,a)`,
INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; BINOM_REFL; binom; ALL_COUNTINGS_0] THEN INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; BINOM_REFL; binom; ALL_COUNTINGS_0] THEN REWRITE_TAC[ARITH_RULE `1 = a + 1 <=> a = 0`; BINOM_EQ_0; ARITH_RULE `a < SUC a`] THEN REWRITE_TAC[ALL_COUNTINGS_SUC; ADD1] THEN ASM_REWRITE_TAC[binom; GSYM ADD1] THEN REWRITE_TAC[ADD_CLAUSES; ADD_AC]);;
let VALID_COUNTINGS = 
prove (`!a b. (a + b) * valid_countings a b = (a - b) * binom(a + b,a)`,
INDUCT_TAC THENL [REWRITE_TAC[VALID_COUNTINGS_0; SUB_0; MULT_CLAUSES] THEN INDUCT_TAC THEN ASM_REWRITE_TAC[VALID_COUNTINGS_0; MULT_CLAUSES; ADD_CLAUSES]; ALL_TAC] THEN INDUCT_TAC THENL [REWRITE_TAC[VALID_COUNTINGS_0; ADD_CLAUSES; BINOM_REFL; SUB_0]; ALL_TAC] THEN REWRITE_TAC[ADD1; VALID_COUNTINGS_SUC] THEN REWRITE_TAC[GSYM ADD1] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[MULT_CLAUSES; ARITH_RULE `a <= b ==> SUC a - SUC b = 0`] THEN MATCH_MP_TAC(NUM_RING `~(a + b + 1 = 0) /\ (SUC a + SUC b) * ((SUC a + b) * (a + SUC b) * y + (a + SUC b) * (SUC a + b) * z) = (SUC a + b) * (a + SUC b) * w ==> (SUC a + SUC b) * (y + z) = w`) THEN ASM_REWRITE_TAC[ADD_EQ_0; ARITH] THEN MP_TAC(SPECL [`SUC b`; `a:num`] BINOM_FACT) THEN MP_TAC(SPECL [`b:num`; `SUC a`] BINOM_FACT) THEN MP_TAC(SPECL [`SUC b`; `SUC a`] BINOM_FACT) THEN REWRITE_TAC[ADD_CLAUSES; FACT] THEN SUBST1_TAC(ARITH_RULE `b + a:num = a + b`) THEN MAP_EVERY (fun t -> MP_TAC(SPEC t FACT_LT)) [`a:num`; `b:num`; `a + b:num`] THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_SUC; GSYM REAL_OF_NUM_SUB; REAL_OF_NUM_LE; LT_NZ; ARITH_RULE `~(a <= b) ==> b <= SUC a /\ SUC b <= a /\ SUC b <= SUC a`] THEN CONV_TAC REAL_RING);;
let BALLOT = 
prove (`!a b. &(valid_countings a b) = if a <= b then if b = 0 then &1 else &0 else (&a - &b) / (&a + &b) * &(all_countings a b)`,
REPEAT INDUCT_TAC THEN REWRITE_TAC[ALL_COUNTINGS_0; VALID_COUNTINGS_0] THEN REWRITE_TAC[LE_REFL; REAL_MUL_LID; LE_0; NOT_SUC; CONJUNCT1 LE] THEN SIMP_TAC[REAL_ADD_RID; REAL_SUB_RZERO; REAL_DIV_REFL; REAL_OF_NUM_EQ; NOT_SUC; REAL_MUL_LID] THEN MP_TAC(SPECL [`SUC a`; `SUC b`] VALID_COUNTINGS) THEN REWRITE_TAC[GSYM ALL_COUNTINGS; LE_SUC] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[ARITH_RULE `a <= b ==> (SUC a - SUC b) = 0`] THEN REWRITE_TAC[MULT_EQ_0; MULT_CLAUSES; ADD_EQ_0; NOT_SUC; REAL_OF_NUM_EQ] THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_SUC; GSYM REAL_OF_NUM_SUB; ARITH_RULE `~(a <= b) ==> SUC b <= SUC a`] THEN CONV_TAC REAL_FIELD);;